معرفی و اموزش چند تابع API
1.Mouse_event
اين تابع واسه شبيه سازی کردن فشرده (یا رها) شدن دکمه های موس هستش:
Private Declare Sub mouse_event Lib "user32" Alias "mouse_event" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
آرگومان اول دکمه ای هستش که ميخواهيم شبيه سازيش کنيم و اين مقدار هارو ميشه بهش داد:
Private Const MOUSEEVENTF_LEFTDOWN = &H2 دکمه سمت چپ فشرده میشه
Private Const MOUSEEVENTF_LEFTUP = &H4 دکمه سمت چپ رها ميشه
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20 دکمه وسطی فشرده ميشه
Private Const MOUSEEVENTF_MIDDLEUP = &H40 دکمه وسطی رها ميشه
Private Const MOUSEEVENTF_RIGHTUP = &H10 دکمه سمت راست فشرده ميشه
Private Const MOUSEEVENTF_RIGHTDOWN = &H8 دکمه سمت راست رها ميشه
بقيه آرگومان ها رو ۰ قرار بدين
حالا عمل فشرده (يا رها) شدن دکمه های موس در جايی که موس قرار داره شبی سازی ميشه:
Private Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Sub Command1_Click()
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
kb_event.۲
اين تابع واسه شبيه سازی فشرده شدن یا رها کردن دکمه های کیبرد هستش:
Private Declare Sub keybd_event Lib "user32" Alias "keybd_event" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
آرگومان اول کلید مورد نظر هستش که توی ویبی میشه از vbkeyA , vbkeyB , ... استفاده کرد.یا میشه از ثابت هایی که توی ای پی آی ویور هست VK_A ... , VK_B , ... استفاده کرد.
آرگومان دوم رو 0 بزارین.سومی آگه 0 باشه عمل فشرده شدن و اگه 2 باشه عمل رها شدن کلید بازسازی میشه.چهارمی رو هم 0 قرار بدین:
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Sub Form_Click()
keybd_event vbKeyA, 0, 0, 0
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
MsgBox KeyCode
End Sub
3.GetWindowRect
این تابع مختصات چهار سمت(چپ راست بالا پایین) یه پنجره رو توی یه متغیر از نوع rect قرار میده:
Private Declare Function GetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hwnd As Long, lpRect As RECT) As Long
آرگومان اول هندل پنجره مورد نظره.دومی هم یه متغییر از نوع rect هستش که تابع مقدار مورد نظر رو توی اون قرار میده.یه label و یه timer توی فرم بزارین و :
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Sub Form_Load()
Timer1.Interval = 10
End Sub
Private Sub Timer1_Timer()
Dim PAPI As POINTAPI, R As RECT
GetCursorPos PAPI
GetWindowRect WindowFromPoint(PAPI.x, PAPI.y), R
Label1.Caption = "Top : " & R.Top & " Bottom : " & R.Bottom _
& " Left : " & R.Left & " Right : " & R.Right _
& " Height : " & R.Bottom - R.Top & " Width : " & R.Right - R.Left
End Sub
اول با استفاده از تابع هاي GetCursorPos و WindowFromPoint هندل پنجره ای که کرسر موس روشه رومیگیریم.بعد با تابع مورد نظر مختصات بالا و پایین و چپ و راست ومقدار طول وعرزش رو بدست میاریم.
4.InternetGetConnectedState
این تابع مشخص میکنه که کامپیوتر چه طوری به اینترنت متصل شده و یا اصلا متصل شده یا نه:
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long,ByVal dwReserved As Long) As Long
آرگومان اول یه متغیر از نوع Long هستش که تابع مقداری که مربوط به نوع ارتباط میشه رو توی این قرار میده.دومی رو هم byval 0& بزارین.
وقتی تابع مقدار رو توی متغیر قرار داد باید با if های متعدد نوع ارتباط رو پیدا کنیم.مقدار میتونه یکی (یا چند تا) از اینا باشه:
Private Const INTERNET_CONNECTION_MODEM As Long = &H1 MODEM ارتباط از طریق
Private Const INTERNET_CONNECTION_LAN As Long = &H2 LAN ارتباط از طریقProxy
Private Const INTERNET_CONNECTION_PROXY As Long = &H4 ارتباط دارای پراكسي هستش
Private Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8 مودم Busy هستش (؟)
Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20 کامپیوتر در حالتOffline هستش
Private Const INTERNET_CONNECTION_CONFIGURED As Long = &H40 کامپیوتر به اینترنت متصل هستش
Private Const INTERNET_RAS_INSTALLED As Long = &H10 روی کامپیوتر نصب شدهRas
اگه مقدار برگشتی تابع 0 باشه کامپیوتر به اینترنت وصل نیست و اگه 1 باشه وصله.
چون ممکنه مقداری که به متغییر داده میشه چند تا از مقدار های بالا باشه (مثلا CONNECTION_CONFIGURED و CONNECTION_MODEM) باید توی If از AND استفاده کنیم و نمیشه از = استفاده کرد:
Private Const INTERNET_CONNECTION_LAN As Long = &H2
Private Const INTERNET_CONNECTION_PROXY As Long = &H4
Private Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8
Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20
Private Const INTERNET_CONNECTION_CONFIGURED As Long = &H40
Private Const INTERNET_RAS_INSTALLED As Long = &H10
Private Sub Form_Load()
Dim lpF As Long, MBStr As String
If InternetGetConnectedState(lpF, ByVal 0&) = 1 Then
If lpF And INTERNET_CONNECTION_CONFIGURED Then
MBStr = "Connection to the internet = True ..." & vbNewLine
End If
If lpF And INTERNET_CONNECTION_MODEM Then
MBStr = "By MODEM" & vbNewLine
End If
If lpF And INTERNET_CONNECTION_LAN Then
MBStr = "By LAN" & vbNewLine
End If
If lpF And INTERNET_CONNECTION_MODEM_BUSY Then
MBStr = "MODEM Busy" & vbNewLine
End If
If lpF And INTERNET_CONNECTION_OFFLINE Then
MBStr = "Offline" & vbNewLine
End If
If lpF And INTERNET_CONNECTION_PROXY Then
MBStr = "Proxy" & vbNewLine
End If
If lpF And INTERNET_RAS_INSTALLED Then
MBStr = "Ras Installed" & vbNewLine
End I
Else
MBStr = "Connected to the internet = False"
End If
MsgBox MBStr
End Sub
**********************
اموزش روش های Shut Down
براي Shut Down كردن سيستم از تابعExitWindowEx استفاده ميشه :
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
پارامتر اول يكي از مقدار هاي زير ميتونه باشه :
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
همش به غير از آخري واضحه.آخري با هر كدوم از بقيه كه تركيب بشه (با Or ) موجب ميشه كه ويندوز برنامه ها رو مجبور به بستن كنه.پارامتر دوم رو هم VbNullString قرار بدين
.مثال :
Private Sub Command1_Click()
ExitWindowsEx EWX_SHUTDOWN or EWX_FORCE, VbNULLString
End Sub
توي ويندوز XP اين روش كار نميكنه.براي شات دانون كردن ويندوز بايد از فايل ShutDown.Exe كه توي دايركتوري سيستم هست استفاده كرد.اين فايل واسه Shut Down كردن چند تا پارامتر ميتونه بگيره كه يكيش رو حتما بايد بش بدين :
-I
يه واسط كاربري نشون ميده كه توي اون كاربر Options ها رو مشخص ميكنه و بعد OK ميكنه تا سيستم خاموش بشه و اگه اين رو استفاده كردين ديگه نياز به پارامتر ديكه اي نيست .البته اين پارامتر اصلا به كار ما نمياد.ما ميخواهيم به طور اتوماتيك سيستم رو Shut Down كنيم.
-l
سيستم Logoff ميشه
-s
سيستم Shutdown ميشه.(توي قسمت هاي قبلي هرجا گفتم Shut Down منظورم Restart , Shutdown , Logoff بود)
-r
سيستم Restart ميشه.
-a
اگه سيستم در حال Shut Down شدن باشه ،اين كار لغو (abort)ميشه.
-t [Seconds]
اين براي زمان بكار ميره.يعني اينكه اگه از اين پارامتر استفاده كنين بايد بعدش يه عدد كه معرف ثانيه هستش بنويسين كه اگه اين كارو بكنين يه پنجره مثل اين نشون داده ميشه و سيستم بعد از زماني كه شما تعيين كردين Shut Down ميشه:
-c "[This is a comment] "
اگه از پارامتر t استفاده كرده باشين با اين پارامتر (c) ميتونين توي قسمت Message يه پيغام براي كاربر نشون بدين مثل ايني كه من گذاشتم (This is a comment) در ضمن طول اين پيغام حداكثر بايد 127 كاراكتر باشه.
-f
مثل مقدار EWX_FORCE توي تابع ExitWindowsEx عمل ميكنه يعني اگه ازش استفاده كنين ويندوز برنامه ها رو مجبور به بستن ميكنه.
حالا ما براي Shut Down كردن بايد اين فايل رو با پارامتر ها باز كنيم.از تابع Shell استفاده ميكنيم :
2 تا دكمه يكي cmdShutDown و يكي ديگه cmdAbort درست كنين :
Private Sub cmdShutDown_Click()
Shell "Shutdown.exe -r –t 30 –f –c " & """" & "This is a comment" & """"
End Sub
Private Sub cmdAbort_Click()
Shell "Shutdown.exe –a"
End Sub
وقتي دكمه cmdShutDown رو بزنين يه پنجره مثل پنجره اي كه عكسش رو گذاشتم ظاهر ميشه و شمارش معكوس از 30 شروع ميشه.اگه به 30 برسه ويندوز رستارت ميشه.اگه دكمه cmdAbort رو بزنين پنجره ي Shut Down بسته ميشه.
حالا يه كد واسه رستارت در همون لحظه :
Private Sub cmdShutDown_Click()
If MsgBox("Are you sure? ",VbCritical + VbYesNo) = VbYes Then
Shell "ShutDown.exe –r –f –t 0"
End If
End Sub
***********************
طبق روال چند تا تابع و روش كار با اونارو آموزش ميدم.
1.AnimateWindow
اين تابع رو بايد در حالتي كه يه پنجره هنوز رسم نشده(يا Hide هست و ...) و يا قبل از پنهان شدن هست بايد فراخواني كرد
بعد از فراخواني تابع پنجره در حالتهاي مختلف به صورت انيميت رسم ميشه يا پنهان ميشه.مثلا از سمت چپ طولش افزايش پيدا ميكنه تا كاملا رسم بشه.اين تابع توي API Viewer نيست:
Private Declare Function AnimateWindow Lib "user32" (ByVal hwnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Boolean
ثابت هاي مورد نياز:
Const AW_HOR_POSITIVE = &H1
Const AW_HOR_NEGATIVE = &H2
Const AW_VER_POSITIVE = &H4
Const AW_VER_NEGATIVE = &H8
Const AW_CENTER = &H10
Const AW_HIDE = &H10000
Const AW_ACTIVATE = &H20000
Const AW_SLIDE = &H40000
Const AW_BLEND = &H80000
اين تابع 3 تا مقدار به صورت byVal ميگيره.اول هندل پنجره مورد نظر.دومي زماني كه ميخواهيم عمل رسم انجام بشه سومي هم روش رسم هست كه بايد ثابت ها را به اين بديم.بعضي از مقادير (آخر) رو ميشه از طريق Or با هم استفاده كرد.
موقتي كه ميخواهيم يك پنجره از حالت رسم شده به حالت پنهان بره بايد مقدار AW_HIDE رو هم به پارامتر آخر (با استفاده از Or) اضافه كنيد.كارهايي كه اين ثابت ها ميكنن:
AW_HOR_POSITIVE پنجره از چپ به راست رسم يا پاك ميشه
AW_HOR_POSITIVE پنجره از راست به چپ رسم يا پاك ميشه
AW_VER_POSITIVE پنجره از بالا به پايين رسم يا پاك ميشه
AW_VER_NEGATIVE پنجره از پايين به بالا رسم يا پاك ميشه
AW_CENTER پنجره از مركز باز ميشه يا بالعكس
AW_ACTIVATE پنجره رو فعال ميكنه
بقيه رو هم درست نفهميدم شما هم امتحان كنين.
يه مثال ميزنم.2 تا دكمه داخل فرم درست كنين و كد زير رو وارد كنين:
Private Declare Function AnimateWindow Lib "user32" (ByVal hwnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Boolean
Const AW_HOR_POSITIVE = &H1
Const AW_HOR_NEGATIVE = &H2
Const AW_VER_POSITIVE = &H4
Const AW_VER_NEGATIVE = &H8
Const AW_CENTER = &H10
Const AW_HIDE = &H10000
Const AW_ACTIVATE = &H20000
Const AW_SLIDE = &H40000
Const AW_BLEND = &H80000
Private Sub Form_Load()
Me.BackColor = vbBlue
AnimateWindow Me.hwnd, 1000, AW_HOR_POSITIVE Or AW_VER_NEGATIVE
Me.Cls
End Sub
Private Sub Command1_Click()
If Command2.Visible = True Then
AnimateWindow Command2.hwnd, 1000, AW_CENTER Or AW_HIDE: Command2.Visible = False
Else
AnimateWindow Command2.hwnd, 1000, AW_CENTER: Command2.Visible = True
End If
End Sub
براي اينكه بعد از رسم تغيير رنگ هاي(احتمالي) ايجاد شده از بين بره(صفحه پاك بشه) از Me.Cls استفاده كردم.
اين رو هم بگم كه در زماني كه تابع داره كارشو ميكنه برنامه كار ديگه اي نميتونه بكنه.در ضمن رنگ زمينه رو عوض كردم تا تغيير اندازه دكمه مشخص بشه.ديگه فكر نكنم توضيحي بخواد.
2.GetBkColor : اين تابع BackColor يا رنگ زمينه پنجره اي كه hDC ش رو بش داديم برميگردونه:
Private Declare Function GetBkColor Lib "gdi32" Alias "GetBkColor" (ByVal hdc As Long) As Long
براي مثال Hdc فرم خودمون رو بش ميديم و مقدار بازگشتيشو با BACKcOLOR فرممون مقايسه ميكنيم(1 دكمه توي فرم بزارين):
Private Declare Function GetBkColor Lib "gdi32" Alias "GetBkColor" (ByVal hdc As Long) As Long
Private Sub Form_Load()
Me.BackColor=VbBlue
End sub
Private Sub Command1_Click()
Dim BKcolor as Long
BKcolor = GetBkColor(Me.hdc)
If BKcolor = Me.BackColor Then
Msgbox "Good!",vbinformation
Else
Msgbox "Wrong!!",vbCritical
End If
End Sub
توجه كنين كه من در Private Sub Form_Load() رنگ زمينه فرم رو از حالت پيشفرض خارج كردم و يه رنگ معمولي بش دادم اين به اين دليل بود كه فرم در حالت پيشفرض داراي رنگ زمينه VbFaceButton (يه رنگ سيستمي) هست و براي همين هم خصوصيت Me.BackColor بجاي اينكه رنگ زمينه واقعي رو برگردونه يه چيز ديگه برميگردونه.
3. GetSystemDirectory
اين تابع براي گرفتن آدرس پوشه سيستم بكار ميره مثلا در ويندوز 98 اگه ويندوز در درايو C نصب شده باشه محل اغلبا"
C:\Windows\System هست.
اين تابع به اين صورته:
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
مقدار اول يه متغير از نوع String هست كه بايد به تابع بديم تا مسير رو توي اون قرار بده.و دومي رو 255 قرار بدين.اين مقدار
نشون ميده كه تابع حداكثر چند كاراكتر اول مسير رو برگردونه.چون طول اين مسير به ندرت 255 ميشه ما اين عدد رو بش ميديم.يه نكته رو توجه كنين كه اين تابع مقدار 255 كاراكتر(كه خودمون مشخص كرديم) رو داخل متغييري كه بش داديم قرار ميده كه كاراكتر هاي اول رو مسير پوشه سيستم و بقيه رو با كاراكتر 0 پر ميكنه.بنابراين ما بايد طور متغير كه در عادي 0 هست رو به 255 تغيير بديم و گرنه چون تابع ميخواد مقدار رو درون تابع جا بده و تابع جا نداره(طولش 0 هستش) اشكال ايجاد ميشه و برنامه ما بسته ميشه.همن اين ها به اين علت هستش كه تابع طول متغير ما رو تغيير نميده(ولي در خود ويبي اگر يه مقداري رو به يه متغير از نوع String بديم طول متغيير خودكار اضافه ميشه.)
براي اينكه ما طول متغير رو براي اين تابع به مقدار 255 كاراكتر تغيير بديم 2 كار ميتونيم بكنيم.يكي از اين روشه:
Dim sysPath as string * 255
توي اين روش طول متغير با استفاده از 255 كاراكتر تغيير ميكنه.(با استفاده از كاراكتر 0)
يا اينكه يه مقدار با طول 255 به متغيير ميديم:
Dim sysPath as String
sysPath = String(255," ")
حالا تابع رو فراخواني ميكنيم:
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Sub Form_Load()
Dim sysPath as String * 255
GetSystemDirectory sysPath,255
Msgbox Replace(sysPath,chr(0),"")
End Sub
در خط يكي مونده به آخر با استفاده از تابع Replace مقدار كاراكتر 0 اضافي كه با تابع داده شده حذف ميشه.
3.GetWindowsDirectory
اين تابع مسير پوشه ويندوز رو برميگردونه و روش كار باش مشابه قبلي هست :
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Sub Form_Load()
Dim winPath as String * 255
GetWindowsDirectory winPath,255
Msgbox Replace(winPath,chr(0),"")
End Sub
۴. GetTempPath
اين تابع هم مسير پوشه Temp رو به ما ميده و يه فرق كوچيك با قبليه داره . جاي آرگومان هاش عوض شده:
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nSize As Long,ByVal pBuffer As String) As Long
Private Sub Form_Load()
Dim tmpPath as String * 255
GetTempPath 255,tmpPath
Msgbox Replace(tmpPath,chr(0),"")
End Sub
5.SetForegroundWindow اين تابع هندل يم پنجره رو ميگيره و اونو فعال ميكنه:
Private Declare Function SetForegroundWindow Lib "user32" Alias "SetForegroundWindow" (ByVal hwnd As Long) As Long
با استفاده از تابع GetCursorPos مكان موس رو ميگيريم و با استفاده از از تابع WindowFromPoint بوسيله مختصات هندل رو ميگيريم و به تابع ميديم(يه تايمر توي فرم بزارين):
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" Alias "SetForegroundWindow" (ByVal hwnd As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Dim PAPI As POINTAPI,phWnd as long
Private Sub Form_Load()
Timer1.Interval = 100
End Sub
Private Sub Timer1_Timer()
GetCursorPos PAPI
phWnd = WindowFromPoint(PAPI.x, PAPI.y)
SetForeGroundWindow phWnd
End Sub
**********************
۱.تابع PlaySound
این تابع واسه پخش کردن یه فایل با فرمت wav از توی speaker هاست.آرگومان اول آدرس فایل و دومی و سومی باید 1 باشه.یه دکمه توی فرم بزارین و کد زیر رو وارد کنین:
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Sub Command1_Click()
PlaySound "D:\File.wav",1,1
End Sub
که باید به جای D:\File.wav آدرس یه فایل با پسوند wav بزارین.
2.GetClassName
این تابع هندل یه پنجره رو میگیره و ClassName ش رو برمیردونه.آرگومان اول هندل پنجره.آرگومان دوم یه متغیر که نام کلاس توش قرار میگیره طول این متغییر باید تعیین شده باشه.سومی هم یه عدد مثل n که وقتی به تابع داده میشه تابع n-1 کاراکتر اول نام کلاس رو داخل متغییر قرار میده.(البته مطمین نستم شایدم n کاراکتر اول رو برگردونه.خودم امتحان کردم n-1 کاراکتر اول رو قرار داد)این عدد رو 255 قرار بدین خیال خودتونو راحت کنین.
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Sub Command1_Click()
Dim ipCName as String * 255
GetClassname Me.hWnd,ipCName,255
Msgbox Replace(ipCName,chr(0),"")
End Sub
واسه توضیح در مورد طول متغیر و چرا اینطوریش کردیم به آموزش تابع GetSystemDirectory سر بزنین.
3. GetAsyncKeyState
با این تابع میتونین بفهمین که قبل از فراخوانی تابع آیا یه کلید فشرده شده یه نه.آرگومانی که تابع میگیره کلیدی که مورد نظرمون هست رو مشخص میکنه.برای مثال
Private Const VK_LEFT = &H25
مربوط به کلید چپ هست.کلیه مقدار ها رو میتونین توی API Viewer پیدا کینین.مقدار برگشتی تابع مشخص میکنه که کلید مور د نظر فشرده شده یا نه .یه دکمه توی فرم بزارین:
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Const VK_LEFT = &H25
Private Sub Command1_Click()
If GetAsyncKeyState(VK_LEFT) Then
Print "<--"
End if
End Sub
در ضمن اگه شما مقدار &H8000 رو هم توی شرط If بزارین عمل چاپ فقط در صورتی که اجرا میشه که کلید چپ در زمان فشره شدن دکمه فشرده شده باشه نه قبلش.
البته در حالت اول برای یک بار فشردن دکمه چپ فقط یک بار عمل چاپ با فشردن دکمه انجام میشه.امتحان کنین تا منظورمو بفهمین.
4.LoadCursorFromFile
این تابع اشاره گر یه فایل کرسر (.cur) رو به مامیده که ازش میشه توی تابع SetSystemCursor استفاده کرد.مثالش رو توی تابع بعدی ببینین.
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
5. SetSystemCursor
با این تابع میشه کرسر سیستم رو تعیین کرد.این تابع اول یه اشاره گر از کرسر مورد نظر ما میخواد که ما این رو با استفاده از تابع LoadCursorFromFile میگیریم آرگوما دوم رو هم Private Const OCR_NORMAL = 32512 قرار بدین(مقدار های دیگه رو میتونین توی API Viewer ببینین).یه دکمه توی فرم بزارین:
Private Declare Function SetSystemCursor Lib "user32" Alias "SetSystemCursor" (ByVal hcur As Long, ByVal id As Long) As Long
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Const OCR_NORMAL = 32512
Private Sub Command1_Click()
Dim hc as long
hc = LoadCursorFromFile("D:\c.cur")
SetSystemCursor hc,32512
End Sub
فایلهای با پسوند .cur که با ویژوال بیسیک نصب شدن رو توی شاخه …\COMMON\GRAPHICS\CURSORS پیدا کنین.به امید دیدار.
************************
1.SetWindowPos
این تابع واسه تغییر مکان و تغییر اندازه Window ها بکار میره و چند تا کاره دیگه هم میکنه:
Private Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
مقدار اولی که میگیره هندل پنجره هستش.دومی طرز قرار گیفتن پنجره در محور z هستش.مثلا بالاتر از پنجره های دیگه قرار بگیره یا پایین تر و ... .مقدار هایی که این میگیره:
Private Const HWND_BOTTOM = 1
Private Const HWND_BROADCAST = &HFFFF&
Private Const HWND_DESKTOP = 0
Private Const HWND_NOTOPMOST = -2
Private Const HWND_TOP = 0
Private Const HWND_TOPMOST = -1
هر کدوم از اینارو بزارین ببینین چی میشه . مثلا topmost بالای پنجره های دیگه جتی اونایی که از قبل
Top بودن قرار میگیره.
مقدار سومی و چهارم هم x و y مختصات پنجره هستش که نسبت به پنجره parent (مادر) ش هستش به طوری که بالا و سمت چپ پنجره ء مادر نقطه (0 ، 0 ) حساب میشه.مقدار بعدی هم عرض و طول پنجره مورد نظر هستش.
حالا اگه نخواهیم همه این خصوصیات پنجره رو تغییر بدیم نمیشه مثل ویبی اونا رو مقدار دهی نکنیم.بعضی از مواقع میشه از Byval 0& استفاده کرد اما در مورد این تابع واسه اینکه نخواهیم همه خصوصیاتش رو تغییر بدیم باید آرگومان آخر رو مقدار دهی کنیم.بعضی از مقدار هایی که این میگیره :
Private Const SWP_NOMOVE = &H2 پنچره تغییر مکان نمیده
Private Const SWP_NOACTIVATE = &H10 پنجره فعال نمیشه
Private Const SWP_NOSIZE = &H1 پنجره تغییر اندازه نمیده
Private Const SWP_NOZORDER = &H4 جای پنجره در محور z عوض نمیشه
Private Const SWP_NOREDRAW = &H8 پنجره دوباره رسم نمیشه
یه تایمر و یه دکمه توی فرم بزارین و کد زیر رو وارد کنین:
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Dim x As Integer, y As Integer
Private Sub Form_Paint()
Command1.SetFocus
Timer1.Interval = 100
End Sub
Private Sub timer1_timer()
x = Int(800 * Rnd())
y = Int(600 * Rnd())
SetWindowPos Me.hwnd, 0, x, y, 0, 0, SWP_NOSIZE Or SWP_NOZORDER
End Sub
Private Sub command1_click()
Unload Me
End Sub
اول focus رو به دکمه میدیم بعد .Interval مربوط به تایمر رو مقدار دهی میکنیم.توی Private Sub timer1_timer هم یه x و y
به طور تصادفی بدست میاریم توی خط بعد هم با استفاده از تابع مورد نظر پنجره رو حرکت میدیم.
حالا بعد از اجرا کردن برنامه کلید اینتر رو که بزنین برنامه بسته میشه.
2.CreateDirectory
این تابع واسه ساختن Folder بکار میره :
Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
آرگومان اول مسر پوشه ای که میخواهیم بسازیم هستش
دومی هم یه متغییر از نوع SECURITY_ATTRIBUTES که نیازی به مقدار دهی کردنش هم نیست
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
برای مثال :
Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Dim SA as SECURITY_ATTRIBUTES
Private Sub Form_Load()
Createdirectory "D:\APItest",SA
End Sub
3.Sleep
این تابع برنامه ای که تابع توش فراخوانی شده رو توی زمانی که بش میدیم متوقف میکنه
آرگومانی که میگیره زمان مورد نظره که بر حسب میلی ثانیه هستش.
یه دکمه توی فرم بزارین :
Private Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
Private Sub Command1_Click()
Sleep 2000 '2000 ms = 2 s
End Sub
4.BlockInput
این تابع بعد از فراخوانیش موس و کیبرد رو قفل میکنه یعنی دیگه کلید هایی که میزنین بر پنجره ها اثر نداره و موس رو که تکون میدین کرسرش حرکت نمیکنه:
Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long
مقداری که میگیره اگه 0 باشه عمل قفل شدن متوقف میشه و اگه 1 باشه موس و کیبرد قفل میشه.اگه با این تابع موس و کیبرد رو قفل کردین یه فکری هم به فکر آزاد کردن موس و کیبرد باشین :
یه تایمر توی فرم بزارین :
Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long
Private Sub Form_Load()
Timer1.Interval = 5000
BlockInput True
End Sub
Private Sub Timer1_Timer()
BlockInput False
End Sub
با این کد عمل قفل شدن 5 ثانیه طول میکشه.
***********************
1.FlashWindow
این تابع واسه آبی کردن و بعد به رنگ معمولی در آوردن (میشه گفت نور انداختن) عنوان و اسم یه (پنجره)فرم توی TaskBar بکار میره .شاید منظورمو نفهمیده باشین.ازش استفاده کنین تا بفهمین:
Private Declare Function FlashWindow Lib "user32" Alias "FlashWindow" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
آرگومان اول هندل پنجره مورد نظر هست.
آرگومان دوم رو 1 قرار بدین (اگه صفر قرار بدین عمل مورد نظر–اگر در حال انجام باشه- متوقف میشه)
یه دکمه توی فرم بزارین:
Private Declare Function FlashWindow Lib "user32" Alias "FlashWindow" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
Private sub Command1_Click()
FlashWindow Me.hWnd , 1
End Sub
Delphi:
procedure TForm1.Command1Click(Sender: TObject);
begin
FlashWindow(form1.Handle,true);
end;
توی این کد من هندل فرم برنامه خودم رو بش دادم.
2.GetForeGroundWindow
این تابع هندل فرم فعال(که رنگ نوار عنوانش با بقیه فرق داره و معمولا آبیه) رو برمیگردونه:
Private Declare Function GetForegroundWindow Lib "user32" () As Long
هیچ مقداری هم نیاز نیست بش بدیم.یه تایمر توی فرم بزارین و Interval ش رو 1 بزارین:
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Sub Timer1_Timer()
Me.Caption = GetForegroundWindow()
End Sub
Delphi:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Form1.Caption := IntToStr(GetForegroundWindow());
end;
3.GetComputerName
این تابع نام کامپیوتری که برنامه داره توش اجرا میشه رو برمیگردونه.این اسم رو میتونین توی قسمت
System Properties (راست کلیک روی My Computer ؛ رفتن به Properties ) توی قسمت Computer Name ببینین.
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
آرگومان اول یه متغیر هست که تابع نام مورد نظر رو توی این قرار میده و طولش باید از قبل تعیین شده باشه.آرگومان دوم هم مشخص میکنه که چند کاراکتر اول نام کامپیوتر توی متغیر قرار بگیره.این عدد باید با طور متغیر برابر باشه یا کوچکتر.بهتره جفتشون رو 255 قرار بدین.:
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Sub Form_Load()
Dim buffer As String * 255
GetComputerName buffer, 255
MsgBox "Computer name : '" & Replace(buffer, Chr(0), "") & "'"
End Sub
Delphi:
procedure TForm1.FormCreate(Sender: TObject);
var Buffer : Array[1..MAX_PATH] of char ;
var MAX_SIZE : Cardinal;
begin
MAX_SIZE := sizeof(buffer) -1 ;
GetComputerName(@buffer,MAX_SIZE) ;
ShowMessage('Computer Name : ' + StrPas(@buffer));
end;
4.GetCurrentDirectory
این تابع آدرس پوشه ای که برنامه جاری توش داره اجرا میشه رو برمیگردونه.یعنی کار App.path رو انجام میده:
Private Declare Function GetCurrentDirectory Lib "kernel32" Alias "GetCurrentDirectory" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
روش مقدار دادن آرگومان هاش هم شبیه تابع قبلیه فقط جای اونا عوض شده یعنی آرگومان اول برای تعداد کاراکتر
اول و آرگومان دوم یه متغییر واسه قرار دادن آدرس توی اون:
Private Declare Function GetCurrentDirectoryA Lib "kernel32" Alias "GetCurrentDirectory" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Sub Form_Load()
Dim buffer As String * 255
GetCurrentDirectoryA 255,Buffer
MsgBox "Current Directory : '" & Replace(buffer, Chr(0), "") & "'"
End Sub
Delphi:
procedure TForm1.FormCreate(Sender: TObject);
var buffer : array[1..MAX_PATH] of char;
begin
GetCurrentDirectoryA(sizeof(buffer),@buffer);
ShowMessage('Current Directory : ' + strpas(@buffer));
end;
5.GetDoubleClickTime
این تابع هم زمان Double Click که توی کنترل پنل توی قسمت موس مشخص شده رو برمیگردوونه:
Private Declare Function GetDoubleClickTime Lib "user32" Alias "GetDoubleClickTime" () As Long
هیچ مقداری هم نمیگیره:
Private Declare Function GetDoubleClickTime Lib "user32" Alias "GetDoubleClickTime" () As Long
Private Sub Form_Load()
Msgbox "DoubleClickTime : " & GetDoubleClickTime()
End Sub
Delphi:
procedure TForm1.FormCreate(Sender: TObject);
begin
ShowMessage('DoubleClickTime : ' + IntToStr(GetDoubleClickTime()));
end;
***************************
1.bitblt
این تابع واسه گرفتن عکس از یه window هستش.در واقع این تابع یه قسمت یا همه پیکسل های یه پنجره(مبدا) رو داخل یه پنجره دیگه (مقصد) کپی میکنه.ما میتونیم یه picture box که توی برناممون هستش رو مقصد قرار بدیم و بعد از قرار داده شدن تصویر پنجره مبدا توی مقصد با SavePicture عکسی که از پنجره مورد نظر گرفتیم رو ذخیره کنیم:
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
آرگومان اول hDC ی پنجره مقصد هستش.دومی x جایی هستش که میخواهییم رسم شدن روی پنجره مقصد از اونجا شروع بشه
سومی هم y جاییه که گفتم.بعدی عرض نقطه ای هستش که میخواهیم عکس تا اونجا گرفته بشه.بعدی طول نقطه ای هستش که گفتم.بعدی hDC ی پنجره ی مقصده.بعدی x نقطه ای هستش که میخواهیم عکس گرفتن از اونجا شروع بشه . بعدی هم y اون نقطه ای هستش که گفتم. آرگومان بعدی هم نوع عکس گرفتن رو نشون میده که مقدار های زیر رو میشه بهش بدیم:
Private Const SRCAND = &H8800C6
Private Const SRCCOPY = &HCC0020
Private Const SRCERASE = &H440328
Private Const SRCINVERT = &H660046
Private Const SRCPAINT = &HEE0086
به طور معمول Private Const SRCCOPY = &HCC0020 رو بايد قرار بديم
یکی از کارهایی که میشه با این تابع کرد عکس گرفتن ازصقحه مانيتوره .یعنی ما با استفاده از تابع getdc ، hdc ی كل صفحه (چیزی که توی مانیتور داره نشون داده میشه) رو به تابع میدیم و با این کار یه عکس از چیزی که توی مانیتور داره نشون داده میشه عکس میگیریم.
یه دکمه و یه PictureBox توي فرم بزارين خصوصيت autoredraw ش رو true كنين و كد زير رو وارد كنين:
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Private Sub Command1_Click()
Picture1.Width = Screen.Width
Picture1.Height = Screen.Height
Me.Hide
BitBlt Picture1.hDC, 0, 0, Screen.Width / 15, Screen.Height / 15, GetDC(0), 0, 0, SRCCOPY
SavePicture Picture1.Image, "D:\test.bmp"
unload me
End Sub
اول اندازه Picture Box رو برابر با اندازه صفحه مانیتور میکنیم تا بشه از کل صفحه مانیتور عکس گرفت.
بعد فرم رو پنهان میکنیم تا عکس خود فرم توی تصویر نیفته. بعد با تابعی که گفتم از صفحه عکس میگیریم.ارگومان اول که hdc ی PictureBox هستش.دومی و سومی رو 0 قرار دادم تا عکس از نقطه 0،0 یعنی از بالا و سمت چپ picturebox شروم به رسم شدن بشه.سومی هم طول و عرض صفحه نمایش هست چون میخواهیم از همه صفحه عکس بگیریم.اونا رو بر 15 تقسیم کردم چون توی ویبی به طور پیشفرض این مقدار ها بر حسب twip به ما داده میشه ولی ما باید بر حسب پیکسل به تابع بدیم.بعدی رو هم که توضیح دادم.2 مقدار بعدی رو هم 0 قرار دادم چون میخوام عکس از نقطه 0و0 صفحه نمایش شروع که گرفتن بشه.بعد از اینکه عکس گرفته شد و توی picturebox قرار گرفت اون رو save میکنیم.بعد هم برنامه بسته میشه.
2.StretchBlt
کار این تابع خیلی شبیه قبلی هستش ولی این تابع علاوه بر اینکه میتونه عکس بگیره عکس مورد نظر رو به نسبتی که بش میدیم میتونه کوچیک و یا بزرگ کنه:
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
همونطور که میبینین 2 تا آرگومان دیگه اضافه شده
عکسی که گرفته میشه در نهایت طول و عرضش برابر nWidth و nHeight میشه و توی picturebox رسم میشه.یعنی اگه ما عکس رو از کل صفحه نمایش بگیریم و مقدار این 2 آرگومان رو نصف طول و عرض صفحه نمایش قرار بدیم چون عکس باید به این اندازه ها در بیاد کل عکس به نسبت کوچک میشه در صورتی که توی تابع قبلی برای اینکه به این اندازه ها در بیاد فقط قسمتی از عکس نمایش داده میشد نه همش یعنی اونجا همه عکس رسم نمیشد ولی اینجا همه عکس نشون داده میشه ولی با اندازه متفاوت(بر عکس این حالت هم اگه 2 آرگومان رو 2 برابر صفحه نمایش مقاد دهی کنیم اتفاق میفته و عکس بزرگ میشه البته توی این حالت برای اینکه همه عکس رسم بشه باید اندازه PictureBox رو هم 2 برابر صفحه نمایش کنیم)
حالا اگه نخواهیم از همه صفحه نمایش(یا کلا پنجره مورد نظر) عکس بگیریم به جای اینکه مثل تابع قبلی nWidth و nHeight رو کم کنیم nSrcWidth و nSrcHeight رو کم میکنیم (باید به عرض و طولی که اول میدیم هم توجه کنین و اوا رو هم کم کنین و اگرنه کار درست انکام نمیشه) در غیر این صورت nSrcWidth و nSrcHeight رو برابر اندازه کل پنجره قرار میدیم .
شاید این توضیحایی که دادم یکم گیجتون کرده باشه و درست متوجه نشده باشین.خودتون که یکم با تابع کار کنین میفهمین چی میگم.
یه برنامه مینویسیم که عکس رو از صفحه نمایش بگیره ول اندازه اونو 2 برابر کنه و اونو ذخیره کنه.یه دکمه و یه PictureBox بزارین و خصوصيت autoredraw ش رو true كنين :
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Private Sub Command1_Click()
Picture1.AutoRedraw = True
Picture1.Width = Screen.Width * 2
Picture1.Height = Screen.Height * 2
Me.Hide
StretchBlt Picture1.hdc, 0, 0, Screen.Width / 7.5, Screen.Height / 7.5, GetDC(0), 0, 0, Screen.Width / 15, Screen.Height / 15, SRCCOPY
Me.Show
SavePicture Picture1.Image, "D:\test.bmp"
End Sub
3.TextOut
این تابع واسه چاپ کردن یه متن روی یه پنجره بکار میره:
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
آرگومان اول hdc ی پنجره مورد نظره.دومی و سومی هم x و y ی مختصات نقطه ای هستش که مخواهیم متن چاپ بشه و اینجا نقطه 0 و 0 بالا سمت چپ پنجره مورد نظره بعدي هم متن مورد نظره بعدی .تعدد کاراکتری هستش که میخواهیم از متنی که به تابع دادیم از سمت چپ جدا بشه و چاب بشه که معمولا چون میخواهیم همه متن چاپ بشه باید این مقدار برار طول متن باشه.در ضمن متن با فونت و رنگ زمینه پنجره ای که hdc ش رو به تابع دادیم رسم میشه:
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Sub Command1_Click()
Dim strText As String, Cnt As Long
strText = "API : Application programming interface... |"
For Cnt = 0 To 2
TextOut GetDC(0), 20 * Cnt * 20, Screen.Height / 30, ByVal strText, Len(strText)
Next
End Sub
4.این تابع هم کار تابع قبلی رو میکنه با این فرق که متن داخل یه محدوده چهار گوش شکل رسم میشه و میشه مشخص کرد با چه فرمتی(حالتی) این کار انجام بشه:
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
آرگومان های اول و دوم و سوم رو قبلا توضیح دادم.چهارمی هم یه متغیر از نوع rect که محدوده چهار گوش رو مشخص میکنه.پنجمی هم نوع چاپ شده هستش که مقدار هایی مثل این هارو میشه به تابع داد :
Private Const DT_BOTTOM = &H8 متن در پایین محدوده rect چاپ میشه
Private Const DT_CENTER = &H1 متن در وسط محدوده rect چاپ میشه
Private Const DT_LEFT = &H0 متن در سمت چپ محدوده rect چاپ میشه
Private Const DT_RIGHT = &H2 متن سمت راست محدوده rect چاپ میشه
به کد زیر توجه کنین:
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Const DT_CENTER = &H1
Private Sub Command1_Click()
Dim strText As String, R As RECT
R.Bottom = 200
R.Top = 0
R.Left = 0
R.Right = Screen.Width / 15
strText = "Applicatrion Programming Interface"
DrawText GetDC(0), ByVal strText, Len(strText), R, &H1
End Sub
توی این کد توی محدوده rect نقطه بالا و چپ 0 و 0 قرار داده شده (گوشه سمت چپ پنجره) و قسمت پایین rect 200 و سمت راست اون به اندازه عرض صفحه نمایش قرار داده شده
و فرمت هم Center (مرکز) قرار داده شده بنابراین وقتی تابع رو فرخوانی میکنیم y ی چیزی که چاپ شده 0 هستش و چون ما فرمت رو مرکز قرار دادیم x متنی که چاپ شده به اندازه نصف عرض صفحه نمایش هستش و وسطش چاپ میشه.
5.ExtracIcon
اين تابع يه اشاره گر از آیکونی که توی یه فایل (اغلبا .dll) قرار گرفته بر میگردونه که از با استفاده از این اشاره گر میشه تابع رو روی یه پنجره رسم کرد(و ذخیرش کرد) :
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
آرگومان اول رو 0 قرار بدین.دومی آدرس فایل مورد نظره.سومی هم Index آیکونی هستش که توی فایل قرار گرفته.(آیکون هایی که به این صورت توی فایل ها قرار میگیرن دارای یه Index هستن)
یکسری از ایکون های ویندوز توی فایل [WinDrive]:\Windows\System\Shell32.dll قرار گرفتن
مثالش رو توی تابع بعد ببینین.
6.Drawicon
این تابع hDc ی یه پنجره و اشاره گر یه آیکون رو میگیره و اون رو توی پنجره رسم میکنه:
Private Declare Function DrawIcon Lib "user32" Alias "DrawIcon" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
آرگومان اول hdc ی پنجره مقصد هستش.دومی X نقطه شروع رسم و بعدی Y اون نقطه هستش.بعدی هم اشاره گر آیکون مورد نظره.
ُخصوصیت AutoRedraw فرم رو True کنین و کد زیر رو وارد کنین:
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Sub Form_Load()
Dim strpath As String, Buffer As String * 255, Cnt As Long
GetSystemDirectory Buffer, 255
strpath = Replace(Buffer, Chr(0), "") & "\Shell32.dll"
'///
Call DrawIcon(Me.hdc, 0, 0, ExtractIcon(0, ByVal strpath, 20))
End Sub
اول با تابع getsystemdirectory محل پوشه سیستم و بعد محل فایل Shell32.dll رو پیدا میکنیم.بعد هم آیکونی که Index ش 20 هست رو روی فرم رسم میکنیم
موضوعات مرتبط: آموزش ، ،
برچسبها:
چند تا ترفند کاربردی در Visual Basic 6.0
*******************************
یکی از دوستان اموزش ارسال فایل با winsock رو خواسته بود که نمونش رو گذاشتم
http://www.iranvig.com/modules.php?name=News&file=article&sid=2253
کامپوننت ارسال نامه و ... توسط زبانهای مختلف از جمله VB
http://www.emailarchitect.net/smtpWEpo-5-08.htm
*******************************
این برنامه برای رشته کامپوتر خوبه (منظورم از نظر کاربرد این برنامه است) این برنامه برای یافتن مسیر در گراف با استفاده از الگوریتم دایجسترا هست .رو این برنامه از نظر گرافیکی خیلی خوب کار شده , این برنامه برای کسانی که می خوان کار با Pixel و مسائل مربوط به گرافیک در VB رو یاد بگیرن خوبه
http://matrix007.persiangig.com/vb/Dijkstra.rar
برنامه نمونه اعمال پوسته یا Skin روی فرم
http://mediavb.persiangig.com/ActiveX/Skin%20Form.zip
********************************
تشخیص فشرده شدن کليدهای کيبرد
یکی از دوستان سوال کرده بودند که چگونه می توان کلیدهای کیبرد را حتی وقتی فوکوس روی برنامه ما نیست تشخیص داد مانند دیکشنری ها که مثلاً با CTRL+F12 فعال می شوند و یا Keylogger ها که کلیدهای فشرده شده را ثبت می کنند
من دو روش زیر را برای اینکار پيشنهاد می کنم :
1 - استفاده از یک تابع کتابخانه ای به اسم GetAsyncKeyState موجود در کتابخانه user32.dll . این تابع ، فشرده شدن یا رها شدن یک کلید را تشخیص می دهد . نحوه declare کردن این تابع بصورت زیر است :
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
حال در برنامه تان یک timer قرار داده و در event آن کد زیر را قرار دهید :
For i = 1 To 255
results = 0
results = GetAsyncKeyState(i)
If results <> 0 Then
Msgbox(Chr(i))
End If
Next
برای مشاهده یک برنامه نمونه به این آدرس مراجعه کنید .
http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=36078&lngWId=1
2 - استفاده از قلاب یا Hook : قلاب ، یک ابزار در مکانیزم مدیریت پیغام سیستم ویندوز است که توسط آن برنامه ها می توانند یک روتین را برای مدیریت و پردازش پیغامهای خاصی قبل از اینکه آن پیغامها به برنامه مقصد برسند نصب نمایند . قلابها باعث کندی سیستم می شوند زیرا حجم پردازشی سیستم روی هر پیغام را افزایش می دهند بنابراین بایستی زمانیکه واقعاً به قلاب نیاز دارید آنرا نصب نموده و هر چه زودتر آنرا حذف نمایید . سیستم ویندوز از انواع زیادی از قلابها پشتیبانی می کند که هر کدام امکان دستیابی به پیغامهای خاصی را مهیا می نمایند برای مثال یک برنامه کاربردی می تواند با استفاده از قلاب کیبرد برای مدیریت و پردازش پیغامهای مربوط به آن ( مثل فشرده شدن یک کلید خاص یا رها شدن آن ) استفاده کند .
برای نصب یک قلاب در برنامه از یک تابع کتابخانه ای به اسم SetWindowsHookEx استفاده می شود . این تابع یک قلاب را به زنجیره قلابهای سیستم اضافه می کند . نحوه declare کردن این تابع بصورت زیر است :
Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
همچنین برای آزاد کردن یک قلاب و حذف آن از زنجیره قلابها از تابع کتابخانه ای UnhookWindowsHookEx استفاده می گردد . نحوه declare کردن این تابع بصورت زیر است :
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
برای ایجاد قلاب کیبرد همچنین نیاز به تعریف یک ثابت است که شماره قلاب کیبرد در آن قرار دارد :
Public Const WH_KEYBOARD = 2
حال بایستی یک تابع پس زمینه یا Callback Function نوشت که به ازای فشرده شدن کیبرد اجرا شود و آدرس آنرا ( با استفاده از کلمه کلیدی Address Of ) بهمراه ثابت فوق به تابع SetWindowsHookEx فرستاد .
*********************************
اموزش Visual basic
http://www.garmsarnews.com/evisualbasic/garmsarnewsvisualbasic1.pdf
http://www.garmsarnews.com/evisualbasic/garmsarnewsvisualbasic2.pdf
http://www.garmsarnews.com/evisualbasic/garmsarnewsvisualbasic3.pdf
http://www.garmsarnews.com/evisualbasic/visualbasic.pdf
*************************************
این برنامه برای ساختن Setup می باشد که با توجه به حجم کم این برنامه ولی بسیار قوی هست. این برنامه دارای امکانات زیادی می باشد به شما توصیه می کنم که حتماً دانلود کنید .
برای ساختن Setup شما باید بدانید که چه فایل هایی را باید به همراه فایل اجرایی بر روی سیستم هدف نصب کنید , شما برای اینکار می توانید یک بار توسط نرم افزار Package & Deployment Wizard که به همراه ویژوال بیسیک نصب می شود یک setup طراحی کنید , بعد از ساخت Setup یک فابل متنی به نام SETUP.LST در کنار فایل Setup.exe ایجاد می شود که در آن تمام فابل های مورد نیاز ذکر شده .
اگر در ساخت Setup با استفاده از این برنامه به مشکل برخوردید لطفاً میل بزنید تا راهنمایتان کنم
دانلود
http://www.free-hoster.cc/users/matrix/downloads/QSetup.zip
**************************************
استفاده از شی File System Object در ویژوال بیسیک
امروز می خوام درباره شی (File Sysytem Object ) که به FSO هم معروف است مطالبی را خدمت شما دوستان ارائه بدم ,این شی قابلیت کار با Drive , Folder , File , TestStream را دارد یعنی شما می توانید پوشه و یا فایلی را از مسیری به مسیر دیگر کپی و حذف و یا منتقل کنید و هم چنین می توانید پو شه ای را در مسیر مورد نظر ایجاد کنید
برای افزودن این شی به برنامه از منوی Project آیتم Refrencese را انتخاب کنید و از آن آیتم Microsoft Script Runtime را تیک می زنید . اکنون نوبت به تعریف یک متغیر از نوع ّFso می باشد
Dim Fso As New FileSystemObject
در ضمن لازم به ذکر است که App.path مسیر جاری را که برنامه اجرایی در آن قرار دارد را بر می گر داند .
Fso.CopyFile App.Path & "\text.txt", "C:\", True ' True For Ovwerwrite
fso.MoveFile App.Path & "\text.txt", "C:\" ' For Move File Of Current Path to "C:\" Path
fso.DeleteFile "c:\text.txt"
همین عملیات بالا را می توان برای Folder هم اجرا کرد . همان طور که متوجه شده اید این شیء بسیار مهم است و می تواند کاربرد های زیادی برایتان داشته باشد مثلاً من در زیر برنامه ای می نویسم که بتواند فایلی را در پو شه System32 ویندوز کپی کند خوب بر ای اینکه بتوان پوشه ویندوز را پیدا کنیم از یک API استفاده می کنم چون امکان داره ویندوز داخل پوشه هایی غیر از نام Windows باشد این کار بر ای بر نامه هایی که می خواهید فایلی را در پوشه ویندوز کپی کنی دکاربرد دارد مثلاً شما می خواهید فونتی را در پوشه font ویندوز کپی کنید.
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long _
) As Long
Dim fso As New FileSystemObject
Public S As String
Public SysDirectory As Long
Private Sub Command1_Click()
fso.CopyFile App.Path & "\vb.txt", S + "\System32\", True
End Sub
Private Sub Form_Load()
S = Space(255)
'Get the Windows directory
WinDirectory = GetWindowsDirectory(S, 255)
S = Left$(S, WinDirectory)
'#######################################
LblSource.Caption = "Source : " & App.Path & "\vb.txt"
LblDestination.Caption = "Destination : " & S & "\System32\"
End Sub
دانلود برنامه نمونه
https://www.sharemation.com/vbcoder/vb/Copy.zip?uniq=-buiawi
*****************************
چگونه از اجراي مجدد يک برنامه در ويژوال بيسيک جلوگيري کنیم؟
خوب با استفاده از کد زير در فرم اصلي برنامه تان مي توانيد از اجراي مجدد (Duplicate) برنامه جلوگيري کنيد
Private Sub Form_Load()
If App.PrevInstance = True Then
Dim Result As Integer
Result = MsgBox("برنامه در حال اجراست", vbInformation, "Warnnig")
Unload Me
End If
End Sub
******************************
برنامه خاموش کردن Windows با يک کليک
در اين برنامه يک پروژه ساده رو به شما معرفی ميکنم که در اون با يک کليک ساده دکمه ميتوانيد ويندوز رو
خاموش کنيد . برای ساخت اين پروژه مراحل زير را طی کنيد :
۱ - ويژوال بيسيک را باز کنيد
۲ - يک فرم جديد ايجاد کنيد
۳ - از جعبه ابزار ويژوال يک دکمه روی فرم قرار دهيد
۴ - روی دکمه دو بار کليک کرده و دستور زير را در رويداد کليک دکمه تایپ کنيد
Shell ("Shutdown ") ' Shuts computer down
همانطور که ديده ميشود در صورت اجرای و فشار دکمه ويندوز خاموش ميشود.
اين دستور دارای سويچ های خاص ميباشد که ميتوانيد در برنامه خود استفاده کنيد . در زير اين
سويچ ها ارائه شده اند :
' Switches:
l Log off profile
s Shut down computer
r Restart computer
f Force applications to close
t Set a timeout for shutdown
m \\computer name Shut down remote computer
i Show the Shutdown GUI
مثال :
Shell ("Shutdown -s -t 5") ' Shuts computer down after timeout of 5
بعنوان مثال در صورت استفاده از فرمان فوق سيستم بعد از 5 ثانيه خاموش ميشود. دقيقا مطابق کدی
که در ويروس ام اس بلستر استفاده شده با اين تفاوت که مدت انتظار برای خاموش شدن سيستم در
اين ويروس 30 ثانيه است
**************************************
چگونه وقفه ايجاد کنيم : مثلا برای بارگذاری فرم
Sub Pause(interval)
Dim Current
Current = Timer
Do While Timer - Current < Val(interval)
DoEvents
Loop
End Sub
*******************************
بيل گيتس : جهاني فكر كنيد؟ محلي عمل كنيد!
*******************************
یک بسته اموزشی کامل که نمیگم چیه و اگه دانلود نکنی از دستت رفته
هر سه بخش رو دانلود کنید و سپس unzip کنید و حجمش کم است
http://www.sharemation.com/MahdiVB678/new2/New.part1.rar?uniq=yvuarx
http://www.sharemation.com/MahdiVB678/new2/New.part2.rar?uniq=yvuarr
http://www.sharemation.com/MahdiVB678/new2/New.part3.rar?uniq=yvuarl
*******************************
تشخیص ادمین بودن کاربر جاری در ویندوز
اگه زمانی خواستید این موضوع رو بفهمید کافیه که از تابع API ی که در shell32 تعریف شده استفاده کنید. صورت کلی این تابع چنین است:
Private Declare Function IsUserAnAdmin Lib "shell32" () As Long
تحت ویندوز 2000 ممکنه که شما خطای با عنوان Can't find DLL entry point دریافت کنید که بهتر است که معرفی تابع را بدین گونه انجام دهید:
Private Declare Function IsUserAnAdmin Lib "shell32" Alias "#680" () As Long
*******************************
DLL ( Dynamic Link Library )
شاید برای شما این سوال مطرح باشد که بعنوان یک برنامهنویس حرفهای چگونه میتوانید با ویژوال بیسیک توابع خود را درون فایلهای DLL بنویسید و در مواقع لزوم آنرا بعنوان توابع API در ویژوال بیسیک یا سایر زبانها مورد استفاده قرار دهید. چیزی که در زبانهایی مانند ویژوال سی و ... راحت قابل دسترس و تولید میباشند. چنانچه در خود VB فقط مورد استفادهتان باشد که خب از طریق کلاسها قابل پیادهسازی است، اما اگر نیاز به این شد تا در نرمافزارهایی که امکان ساخت توابع سطح پایین در آنها مقدور نیست مورد استفاده قرار گیرند چه باید کرد؟ بعنوان مثال در نرمافزار MultiMedia Builder یا Wise Install Master که امکان صدا زدن توابع API در آنها پیشبینی شده است.
حتی کاربرد دیگری که میتوان برای این تکنیک جست، جهت کم کردن حجم برنامه اصلی و مهندسیتر شدن پروژه است. شما ماژولهای متنوعی از برنامه را درون فایلهای DLL تعریف کنید و در پروژه و در هنگام لزوم از آن استفاده کنید، چیزی که در اکثر نرمافزارهای مهندسی وجود دارد که میتوان به PlugInها اشاره کرد. همانند نرمافزار Winamp.
برای این منظور شما را با مقالهای در این باب آشنا میکنم که امکان بهرهبرداری از آن نیز وجود دارد.
به آدرس http://www.vb-helper.com/howto_make_standard_dll.html مراجعه کنید تا شرح کاملی در اینباره بیابید.
برای نمونه عملی هم این فایل را دانلود کنید.
http://www.vb-helper.com/HowTo/howto_make_standard_dll.zip
*******************************
تبدیل متن به گفتار جالبه Speech SDK 4.0
http://downloads.pcworld.com/pub/new/graphics_and_multimedia/audio/audio_tools/sapi4sdk.exe
*******************************
ضبط صدا به فرمت دلخواه با ویژوال بیسیک
با این برنامه به فرمت دلخواه صدا را ضبط کنید. آن هم به شکلی خیلی ساده.
راههای زیادی برای رسیدن به ضبط صدا هست! اما هدف من در اینجا ضبط صدا به فرمت دلخواه است، مثلا mp3 و بدون استفاده از ابزارهای برنامهنویسی نظیر ActiveX و ...
ما میخواهیم با استفاده از توابع API به این هدف برسیم. توابع در دسترس برای پخش و ضبط صدا عبارتند از mciSendString، mciSendCommand و mciExecute. (برای آشنا شدن با این توابع میتوانید به سراغ MSDN بروید.)
این توابع هر کدام پیچیدگی خاص خودشان را دارند. مخصوصا اگر قصد ضبط صدا را داشته باشید که باید پارامترهای زیادی را تنظیم کنید که نرخنمونه برداری، تعداد کانال صوتی، بافر و ... را شامل میشوند.
من قصد دارم شما را با تابع mciSendCommand آشنا کنم که با وجود پیچیدگی بیش از حد، استفاده راحتتری از آن هم میسر هست و البته به طریقی که آموزش میدهم.
بهتر هست با یک مثال شروع کنیم:
شکل کلی این تابع این چنین هست:
Public Declare Function mciSendCommand Lib "winmm.dll" _
Alias "mciSendCommandA" (ByVal wDeviceID As Long, _
ByVal uMessage As Long, _
ByVal dwParam1 As Long, _
ByVal dwParam2 As Any) As Long
پخش فایل صوتی شامل چند مرحله است:
1- باز کردن فایل صوتی
2- دستور پخش
3- بستن فایل (که حتما باید انجام بشه)
باز کردن فایل صوتی خود شامل پارامترهایی است که در ساختار زیر مشخص میشود:
Private Type MCI_OPEN_PARMS
dwCallback As Long
wDeviceID As Long
lpstrDeviceType As String
lpstrElementName As String
lpstrAlias As String
End Type
البته باید ذکر کنم که برخی پارامترها در شرایط خاصی مقدار دهی میشوند تا کار مشخصی را انجام دهند (پارامتر سوم، بعدا مثال میآرم)
کد زیر یک فایل صوتی را باز میکند و هندل آن را در صورت موفقیت جایی نگه میداریم، چون از این به بعد ما با این هندل خیلی کار داریم.
پارامتر آخر از تابع mciSendCommand حاوی ساختار مرتبط با نحوه عمل است.
Dim dwReturn As Long
Dim mciOpenParms As MCI_OPEN_PARMS
'Open a waveform-audio device with filename for play.
mciOpenParms.lpstrDeviceType = "WaveAudio"
mciOpenParms.lpstrElementName = filename dwReturn = mciSendCommand(0, MCI_OPEN, _
MCI_OPEN_ELEMENT Or MCI_OPEN_TYPE, _
mciOpenParms)
If dwReturn Then
MsgBox "Failed to open device; don't close it, just return error."
Exit Sub
End If 'The device opened successfully; get the device ID.
wDeviceID = mciOpenParms.wDeviceID
و برای پخش از کد زیر استفاده میکنیم که بعد از کد باز کردن فایل میگذاریم:
dwReturn = mciSendCommand(wDeviceID, MCI_PLAY, 0, vbNull)
If dwReturn Then
mciSendCommand wDeviceID, MCI_Close, 0, vbNull
MsgBox "MCI_PLAY not succed!"
Exit Sub
End If
اگر دقت کنید پارامتر سوم مقدار صفر را داراست. این پارامتر میتواند به نحوی مشخص شود که با اجرای دستور پخش، کنترل به برنامه داده شود یا تا زمانی که پخش به اتمام نرسیده برنامه منتظر بماند. و مشخههای دیگر.
چون ذکر نکردیم پس کنترل برنامه را در حین پخش در دست میگیریم.
و سرانجام با این کد فایل را میبندیم:
Dim dwReturn As Long dwReturn = mciSendCommand(wDeviceID, MCI_Close, MCI_WAIT, vbNull)
If dwReturn Then
mciSendCommand wDeviceID, MCI_Close, 0, vbNull
MsgBox "MCI_Close not succed!"
Exit Sub
End If
و اما ضبط صدا. برای ضبط باید از ساختار پیچیده زیر استفاده کنیم:
Private Type MCI_WAVE_SET_PARMS
dwCallback As Long
dwTimeFormat As Long
dwAudio As Long
wInput As Long
wOutput As Long
wFormatTag As Integer
wReserved2 As Integer
nChannels As Integer
wReserved3 As Integer
nSamplesPerSec As Long
nAvgBytesPerSec As Long
nBlockAlign As Integer
wReserved4 As Integer
wBitsPerSample As Integer
wReserved5 As Integer
End Type
برای یک ضبط ساده باید این همه پارامتر را مقدار دهی کنید و تازه ممکن است صدا بر اساس مقادیر اشتباه بی کیفیت و نامطلوب ضبط شود.
از همه اینها که بگذریم قصد من این بود تا ترفندی را به شما آموزش بدهم که خیلی راحت صدا را به هر فرمتی که خواستید ضبط کنید.
.:: CODEC ::.
این کلمه مخفف واژههای COmpress/DECompress هست و به زبان سادهتر درایوری است که عمل کدسازی و دیکودسازی اطلاعات را انجام میدهد، البته برای کاربر محسوس نیست و به نوعی در پشت پرده انجام میگیرد.
وقتی شما فایلهای wav را در سیستم پخش میکنید، باید codec فایلهای wav در سیستم نصب شده باشد وگرنه قادر به پخش نیستید که البته بهمراه ویندوز این درایورها نصب میشوند.
برای فایلهای mp3 نیز همین قضیه صادق هست و غیره.
برای اینکه بدانید بر روی سیستم شما چه codecهایی نصب شده مراحل زیر را دنبال کنید:
Control Panel -> Sound & Audio Device -> Hardware -> select Audio Codec from list -> click on Properties.
با این توضیحاتی که آمد میخواهیم بر اساس یکی از codecهای نصب شده اقدام به ضبط صدا کنیم.
لازم به ذکر است که برخی codecها فقط حاوی بخش پخش هستند و امکان ضبط رو ندارند!
برسیم به هدف اصلی از این صحبتها.
1- Sound Recorder ویندوز رو باز کنید و سپس از منوی File گزینه Save As... را انتخاب کنید.
2- دکمه Change را کلیک کنید تا لیست codec ها ظاهر شود.
3- گزینه Format را با codecی که میخواهید تنظیم کنید.
4- OK کنید و بعد نام فایل را مشخص کنید و Save نمائید.
با طی این 4 مرحله شما یک فایل صوتی ساختید که فقط حاوی تنظمیات صدا است. یعنی تمام پارامترهای ساختار MCI_WAVE_SET_PARMS
حالا اگر با تابع mciSendCommand این فایل را باز کنید و اقدام به ضبط صدا نمائید، در واقع دارید به فرمتی که میخواهید صدا را ضبط میکنید و درگیر تنظیمات خاصی نیستید.
سورسی را که مربوط به همین بخش است، این صحبتها را پیادهسازی کرده و نمونه کاملی از ضبط و پخش به فرمت دلخواه را انجام میدهد.
و این نکته که دو فایل با پسوند mrf در کنار برنامه هست، در واقع فایلهای حاوی ساختار هستند(wav) که پسوندشان عوض شده.
برنامه ابتدا لیست تمام فایلهای با پسوند mrf را لیست میکند و در هنگام ضبط به همان فرمتی که انتخاب میکنید اقدام به ضبط میکند.
شما میتوانید هر ساختاری را که دوست داشتید با Sound Recorder بسازید و با پسوند mrf در کنار برنامه ذخیره کنید و از نزدیک با چگونگی عمل ضبط آشنا شوید.
http://h1.ripway.com/PalizeSoftware/Files/WaveRecordTest.zip
*******************************
معرفی هیستوگرام تصویر و چگونگی تهیه آن
شبیه سازی نمودار هیستوگرام در فتوشاپ
هیستوگرام مشخص کننده میزان روشنایی یا تیرگی تصویر هست.
به عبارتی تعداد پیکسلهای تصویر ما را در بازهای از دو رنگ تیره(مشکی) و روشن(سفید) مشخص میکند، یعنی همان نمودار فراوانی رنگ پیکسلها.
در سطوح حرفهای برای یک عکاس این نمودار حائز اهمیت است، چرا که به روشنی یا تیرگی عکس پی میبرد. امروزه دوربینهای دیجیتال سطح بالا قادر هستند تا بعد از شکار عکس، نمودار هیستوگرام آنرا نمایش دهند.
سورس زیر این نمودار را بر اساس همین روش پیاده کرده و هیستوگرام مربوطه را با قابلیت تفکیک کانالهای قرمز، سبز و آبی به نمایش میگذارد
http://h1.ripway.com/PalizeSoftware/Files/Histogram.zip
*******************************
تبدیل به سطوح خاکستری (GrayScale)
امروز برای شما سورسی رو تدارک دیدم که بتونید تصاویر رنگی رو به تصاویر خاکستری (GrayScale) تبدیل کنید.
در واقع تبدیل یک پیکسل رنگی به طرح خاکستری خیلی راحت صورت میگیرد.
میدونیم که هر رنگ دارای سه مؤلفه قرمز، سبز و آبی است. برای تبدیل به طرح خاکستری کافیه که رنگ قرمز رو در ضریب 0.3، سبز رو در ضریب 0.59 و آبی رو در ضریب 0.11 ضرب کنید.
در آینده شما رو با تکنیکهای دیگهای در زمینه گرافیک آشنا خواهم کرد. پس چه بهتر که شما بفرمائید در چه زمینههایی مشتاق هستید بدونید
http://h1.ripway.com/PalizeSoftware/Files/GrayScale.rar
*******************************
فایلهای Zip
قابلیت فشردهسازی و استخراج فایلهای فشرده (در نوع ZIP) رو به نرمافزارهای خود اضافه کنید یه خبر قابل دانلود دارم. فایل زیر که بصورت API مورد استفاده قرار میگیره (اصل موضوع همینه که میتونید در هر نرمافزاری که قابلیت فراخوانی توابع API رو داره بکار بگیرید.) قادره با سرعت بالا (وحشتناک و غیر قابل تصور) اقدام به فشردهسازی و استخراج این قبیل فایلها بپردازه.
حتی قادرید مشخص کنید که از چه نوع فشردهسازی استفاده کنه. ضمن اینکه قادرید بصورت CallBack پیشرفت کارش رو هم تحویل بگیرید یعنی خیلی برنامهنویس رو تحویل گرفتهاند که این رو هم نوشتهاند!
نکته آخر اینکه این موضوع رو (با همین عنوان) قبلا در سایت برنامهنویس قرار داده بودم و برای دوستانی که ممکنه ندیده باشند، اینجا هم گذاشتم
http://h1.ripway.com/PalizeSoftware/files/bszipdll.zip
*******************************
زیر نظر گرفتن تغییرات یک شاخه یا زیر شاخه
با گوگل دسکتاپ کار کردید؟ اگر نه که پیشنهاد میکنم حتما یکبار امتحان کنید تا به ارزشش پی ببرید. با برنامههایی که در پشت پرده عمل ایندکسگذاری فایلها رو انجام میدهند چی، آشنا هستید؟ منظور برنامههایی که کار جستجو رو راحت میکنند تا کاربر سریعتر به جستجوی فایلها بپردازد. آیا اینگونه برنامهها بطور مداوم باید فایلها و پوشهها رو زیر نظر داشته باشند تا به محض رؤیت تغییر جدید، بانک خود را اصلاح کنند؟ اگر بدین شکل باشد که این کار پردازنده را زیر بار میبرد، نه؟
حالا اگر این کار در بطن سیستمعامل نهفته باشد و به محض تغییر محتویات اعم از ایجاد و حذف فایل، تغییر فایل، تغییر خصلت فایل، اندازه و ... در مسیری به ما اطلاع داده شود، کار ما سادهتر شده و بار زیادی هم از روی دوش پردازنده برداشته میشود. سورس زیر رو ببینید تا بطور عملی در نحوه استفاده از این قبیل توابع آشنا شوید.
http://h1.ripway.com/PalizeSoftware/Files/watchdir.rar
*******************************
فیلتر کردن بعضی از کلید های صفحه کلید
Private Sub Form_KeyPress(KeyAscii As Integer)
Dim svalid As String
svalid = "0123456789"
If InStr(svalid, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
MsgBox "Not valid Keys.please Press 0-9 keys"
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
MsgBox "The form cannot be close.farzad dh."
Dim leftI As Long
Dim rightI As Long
leftI = Form1.Left + 1000
rightI = Form1.Top + 1000
Dim a As New Form1
a.Width = Me.Width
a.Height = Me.Height
a.Left = leftI
a.Top = rightI
a.Show
End Sub
*******************************
یک کار جالب با موس
فقط یک تایمر با زمان 500 روی فرم قرار بدین و این کدها رو داخلش کپی کنید
Dim farzadvb
Dim bestforvb6
Dim temp
Randomize 1000
farzadvb = Rnd(10) * 1000
bestforvb6 = Rnd(10) * 1000
temp = SetCursorPos(farzadvb, bestforvb6)
********************************
چگونه متن داخل يک TextBox را Select کنيم :
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
End Sub
*******************************
چگونه مسير نصب ويندوز را پيدا کنيم :
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Function WinDir() As String
Dim Wind As String
Wind = Space(500)
Wind = Left(Wind, GetWindowsDirectory(Wind, Len(Wind)))
WinDir = Wind
End Function
*******************************
یکی از دوستان سوال کرده بودند که "چه جوری میشه برنامه خودشو کپی کنه تو فولدر StartUp ویندوز؟"
خوب شما باید از دستور FileCopy استفاده کنید به این ترتیب:
FileCopy App.Path + "\" + App.EXEName + ".exe", "Windows Drive\Documents and Settings\User Name\Start Menu\Programs\Startup" + "\" + App.EXEName + ".exe" 'Copy Function
در این دستور که دستور کپی میباشد به جای:
Windows Drive درایو ویندوز را قرار دهید
User Name نام کاربر را بنویسید البته میتوانید از کلمه All Users نیز استفاده کنید که مخصوص تمام کاربران میباشد(نتیجه این کار را پس از رستارت میبینید)
در اینجا :
App.Path یعنی از درایو تا فولدر برنامه
App.EXEName یعنی نام فایل برنامه
".exe" به دلیل اینکه پسوند فایل نیز به دستور اضافه شود میباشد
*******************************
ساختن جدول در بانک اطلاعاتی
از منوی project گزینه refrences رو انتخاب کنید - بعد اونجا گزینه Microsoft ActiveX Data Objects 2.0 library پيدا کنيدو تيک بزنيد - Adodc مورد نظرتون رو هم با دیتابیس set کنید - بعد :
Dim db_file As String
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim NumRec As Integer
Set conn = New ADODB.Connection
conn.ConnectionString = Adodc1.ConnectionString
conn.Open
On Error Resume Next
conn.Execute "DROP TABLE Jadid"
On Error GoTo 0
conn.Execute "CREATE TABLE Jadid(" & "One INTEGER NOT NULL," & "Two VARCHAR(40) NOT NULL," & "Three VARCHAR(40) NOT NULL)"
conn.Execute "INSERT INTO Jadid VALUES (1,'4','7')"
conn.Execute "INSERT INTO Jadid VALUES (2,'5','8')"
conn.Execute "INSERT INTO Jadid VALUES (3,'6','9')"
Set rs = conn.Execute("SELECT COUNT (*) FROM Jadid")
NumRec = rs.Fields(0)
conn.Close
MsgBox "Created ... "
*******************************
کتابچه سورس
يكي از راههاي اينكه شما بتونيد روش كد نويسي رو خوب ياد بگيريد و يا از كدهاي استاندارد و از پيش نوشته شده در برنامه هاتون به خوبي استفاده كنيد اينه كه از كدهاي نوشته شده كتابها استفاده كنيد. به همين دليل هم به دوستان عزيز پيشنهاد مي كنم براي اين منظور به سايت انتشارات Wrox سر بزنن و از هر كتابي كه دلشون ميخواد هر سورسي رو دوست دارن بردارن. شما مي تونيد از كدهاي اونها كه واقعاً با توضيحات خوب نوشته شدن استفاده كنيد. براي اين منظور به این ادرس بروید
http://www.wrox.com/dynamic/books/download.aspx
*******************************
نحوه تولید DLL با ویژوال بیسیک
بعنوان یک زبان برنامهنویسی با توسعه سریع، ویژوال بیسیک نظر خیلی از برنامهنویسان را از جهت سادگی به خود معطوف کرد. برنامهنویسی با ویژوال بیسیک در کمترین زمان صورت میگیرد حال آنکه در مقابل زبانهایی چون C و ++C اغلب اوقات به روزها کار مفید نیاز است.
اما بیشترین انتقادی که برنامهنویسان از ویژوال بیسیک دارند در این است که قادر به تولید کتابخانههای پویا (DLL) نیست. حقیقتا این نظر مورد قبول است که نمیتوان این نوع فایلها را در کنار فایلهای اجرایی(Exe) یا ActiveX Exe تولید کرد.
در این مقاله ما قصد داریم که نگاه دقیقی به نحوه تولید فایلهای اجرایی در ویژوال بیسیک یندازیم و بعد با طی مراحل سادهای موفق به ایجاد فایلهای DLL بشویم تا از زیر بار این انتقاد نیز رهایی یابیم.
قبلا به این موضوع اشاره شد که فایهای DLL آن دست از برنامههایی هستند که یکبار نوشته میشوند و در پروژههای بعدی بکرات میتواند از آنها استفاده برد. چیزی که هسته ویندور را تشکیل میدهد اینگونه فایلها هستند. علاوه بر آن تکنیکهایی وجود دارد که شما را قادر میسازد تا برنامههایی بنویسید که قادرند خود را بروز برسانند و یا خود ترمیم باشند. بهتر از آن اینکه برنامهای بنویسید که با الحاق اینگونه فایلها بدان قدرت و امکانات جدید بدان افزود. همانند نرمافزارهای رایج از جمله Winamp.
کتابخانههای پویای قابل اتصال (DLL) چه هستند؟
یک DLL مجموعهای از توابع و پروسههایی است که میتواند از برنامه یا DLLهای نظیر خود فراخوانده شود.
استفاده از اینگونه کتابخانههای دو مزیت اصلی دارد:
1- امکان به اشتراک گذاری از کد را فراهم میسازند. یک DLL میتواند مورد استفاده خیلی از برنامههای قرار گیرد. بعنوان مثال کتابخانه Win32 API نمونهای از این سری فایلها است. بعلاوه از زمانی که پروسههای گوناگون قادر به فراخوانی یک DLL واحد هستند امکان به اشتراک گذاری کدها و روتینها فراهم آمده است. یک فایل DLL تنها یکبار به درون حافظه لود میشود و بارها توسط پروسههای گوناگونی مورد استفاده قرار میگیرد و این یعنی مدیریت حافظه بهتر.
2- مزیت دیگر امکان نوشتن برنامهها بصورت اجزای منفصل است که این اجزا خود قابل تعویض با نگارشهای جدیدتر جهت توسعه نرمافزار خواهند بود بدون اینکه خطی از کد برنامه اصلی دگرگون شود.
با این توصیف فایلهای کتابخانهای درونی که در پروژههای مورد استفاده قرار میگیرد در صورت تغییر نیاز هست تا پروژه اصلی دوباره کمپایل شود تا بتوان با آن ارتباط بر قرار کرد. اما در DLL ها چون بصورت پویا و قابل انعطاف نوشته شدهاند این اتصال در بیرون از بدنه اصلی و درست در زمان فراخوانی آن قبیل از متدها و توابع شکل میگیرد و این خود تفاوت آشکار از مزیت این گونه از فایلها میباشد.همچنین یک فایل DLL میتواند حاوی توابعی باشد که فقط مورد استفاده خود هست و از درون به آن دسترسی نخواهیم داشت و آندسته از تابعی را که نیاز هست معرفی میکنیم تا از بیرون بدان دسترسی داشته باشیم. در این مرحله نیاز به معرفی در فایلهای Def هست که در پروژههای C و C++ مورد استفاده قرار میگیرد.
و اما ساختار DLL
فایلهای DLL حاوی یک مدخل شروع انتخابی (optional entry point) و پایانی هستند که در زمانی که توسط برنامههای دیگر به درون حافظه لود یا آنلود میشوند قابل اجرا است. ویندوز این پروسه را در زمانی که یک برنامه DLLها را بدرون حافظه لود یا آنلود میکند اجرا میکند.
این دو نوع پروسه به DLL این امکان را میدهد که یک سری از مقدمات را پیش از استفاده مهیا کند یا بعد از استفاده پاکسازی نماید. در ویژال بیسیک این تابع بدین گونه تعریف میشود:
Public Function DllMain(hinstDLL As Long, fdwReason As Long , lpwReserved As Long) As Boolean
که پارامترهای آن بدین قرارند:
hInstDLL که حاوی یک مقدار یکتا بعنوان دستگیره فایل DLL است.
fdwReason مشخص کننده دلیل فراخوانی این پروسه توسط سیستمعامل است که یکی از چهار مقدار زیر را به خود منتصب میکند:
DLL_PROCESS_ATTACH (1): یک پروسه در حال لود DLL به دورن حافظه است. هر پیشنیاز باید در اینجا شکل گیرد.
DLL_THREAD_ATTACH (2): یک ریسمان (Thread) برای این DLL در حال تولید است. هر پیشنیاز برای ایجاد ریسمان در این مرحله میتواند شکل بگیرد.
DLL_THREAD_DETACH (3) ریسمان در حال پایان یافتن است. به منظور پاکسازی DLL از حافظه.
DLL_PROCESS_DETACH (0) فایل DLL در حال خروح از حافظه است. بمنظور پاکسازی سایر کارها توسط برنامهنویس امکان انجام در این مرحله فراهم آمده است.
lpvReserved: حاوی مقدار اضافی در استفاده از DLL_PROCESS_ATTACH یا DLL_PROCESS_DETACH میباشد.
مقدار برگشتی تابع DllMain در هنگام صدا زدن بصورت DLL_PROCESS_ATTACH مقدار TRUE را باید به خود بگیرد.
در تلاش برای تولید و توسعه یک DLL نمونه قصد این را داریم که یک کتابخانه ریاضی تشکیل دهیم. کد زیر در ماژولی بنام MathLib.Bas قرار میگیرد:
Option Explicit
Public Const DLL_PROCESS_DETACH = 0
Public Const DLL_PROCESS_ATTACH = 1
Public Const DLL_THREAD_ATTACH = 2
Public Const DLL_THREAD_DETACH = 3
Public Function DllMain(hInst As Long, fdwReason As Long, lpvReserved As Long) As Boolean
Select Case fdwReason
Case DLL_PROCESS_DETACH
' No per-process cleanup needed
Case DLL_PROCESS_ATTACH
DllMain = True
Case DLL_THREAD_ATTACH
' No per-thread initialization needed
Case DLL_THREAD_DETACH
' No per-thread cleanup needed
End Select
End Function
Public Function Increment(var As Integer) As Integer
If Not IsNumeric(var) Then Err.Raise 5
Increment = var + 1
End Function
Public Function Decrement(var As Integer) As Integer
If Not IsNumeric(var) Then Err.Raise 5
Decrement = var - 1
End Function
Public Function Square(var As Long) As Long
If Not IsNumeric(var) Then Err.Raise 5
Square = var ^ 2
End Function
*******************************
توابع SaveSetting و GetSetting
» وقتي شما برنامه اي مانند ويژوال بيسيك را اجرا مي كنيد و در محيط كاري آن تغييراتي ايجاد مي نماييد ، اين تغييرات براي اجراي بعدي برنامه ثبت مي شوند . براي مثال اگر شما ToolBox وي بي را مخفي كنيد در اجراي بعدي آن ToolBox نمايش داده نخواهد شد . اين امر در بسياري از برنامه هاي ديگر نيز صدق ميكند . اين تغييرات كه در اصطلاح ( Setting ) نام دارند يا در رجيستري يا در يك فايل ذخيره مي شوند . خود VB اين تغييرات را در رجيستري ثبت ميكند و هنگام اجرا محيط خود را بر اساس اين داده ها تنظيم مي نمايد .
» هنگامي كه كلمه رجيستري در VB به گوش برنامه نويسان مي رسد سريع ذهن آنها را متوجه توابع پيچيده API مربوط به كار با رجيستري مي كند . براي همين من امروز مي خواهم روش ذخيره كردن تنظيمات يك برنامه در رجيستري را بدون استفاده از توابع پيچيده مخصوص كار با رجيستري به وسيله دو تابع بسيار ساده مخصوص اين كار به شما معرفي كنم :
» تابع SaveSetting : براي ساخت كليد و ذخيره كردن اطلاعات در رجيستري .
( SaveSetting ( AppName As String , Section As String , Key As String , Setting As String
_ AppName : اين پارامتر مشخص كننده نام برنامه ( پروژه ) است . البته هر نوشته ديگري هم مي تواند باشد كه نام كليد اصلي در رجيستري را مشخص مي كند .
_ Section : اين پارامتر نا كليد زير شاخه است كه بيشتر از نام Setting براي آن استفاده مي كنند .
_ Key : اين پارامتر مشخص كننده نام كليد از نوع String است كه داده ها در آن ذخيره مي شوند .
_ Setting : اين پارامتر هم كه اصلي ترين بخش است همان داده يا مقداري است كه در كليد ذخيره مي شود .
» براي مثال : تابع با پارامتر هاي ورودي زير مقدار رشته ( "1" ) را در كليد SampleKey ذخيره مي كند .
"SaveSetting "Test" , "Setting" , "SampleKey" , "1
_ شايد از خودتان بپرسيد كه مسير اين كليد در رجيستري چگونه است . كليه اين كليدها و مقادير كه ايجاد مي شوند در آدرس زير قرار مي گيرند و ما نمي توانيم از آدرس ديگري استفاده نماييم :
\HKEY_CURRENT_USER\Software\VB and VBA Program Settings
در مثال قبلي مقادير در شاخه زير ذخيره مي شوند كه شما مي توانيد با مراجعه به آن به اين مطلب پي ببريد :
HKEY_CURRENT_USER\Software\VB and VBA Program Settings\Test\Setting
» تابع GetSetting : براي خواندن اطلاعات از رجيستري .
(GetSetting ( AppName As String , Section As String , Key As String , Setting As String
_ پارامتر هاي اين تابع به جز گزينه آخر كه در اين تابع جايي ندارد دقيقا شبيه به هم هستند :
( " KeyValue = GetSetting ( " Test" , "Setting" , "SampleKey
_ در اين مثال مقدار ( 1 ) را كه قبلا با تابع قبلي در كليد SampleKey قرار داديم درون متغير KeyValue قرار مي گيريد .
» برنامه نمونه : حال مي خواهيم برنامه جالبي با استفاده از اين توابع معرفي شده بنويسيم .
شرح برنامه : مي خواهيم برنامه اي بنويسيم كه داراي تعداد مشخص اجرا باشد . يعني كاربر فقط بتواند پنج بار اين برنامه را اجرا كند و در هر بار اجراي آن پيغامي مبني بر تعداد باقيمانده دفعات اجرا براي كاربر نمايش داده شود و هنگامي كه اين تعداد به پايان رسيد پيغامي نمايش داده شود كه ديگر كاربر نمي تواند اين برنامه را اجرا نمايد . مانند برنامه هايي كه داراي قفل يا به اصطلاح رجيستري هستند .
_ براي اين كار شما فقط كافي است كدهاي زير را در Form_Load برنامه خود قرار دهيد :
()Private Sub Form_Load
Dim RunCount As String
( "RunCount = GetSetting("Test", "Setting", "RunCount
If Val(RunCount) > 5 Then
_,"مهلت اجراي برنامه به پايان رسيده و شما ديگر قادر به اجراي آن نخواهيد بود"MsgBox vbExclamation , "اتمام مهلت"
End
Else
_ ,"شما فقط " & ((Str(4 - Val(RunCount & " بار ديگر مي توانيد اين برنامه را اجرا كنيد" MsgBox
vbInformation, "تعداد اجراي باقيمانده"
(SaveSetting "Test", "Setting", "RunCount", Str(Val(RunCount) + 1
End If
End Sub
حال فايل exe از برنامه خود بسازيد و آن را اجرا نماييد
*******************************
سوال :دستوری می خوام که بتونم يک کلمه را توی يک فيلد بانک اطلاعاتي جستجو کنم نه اينکه اون کلمه اول نوشته باشه . اين کلمه ممکنه وسط هم نوشته شده باشه
برای کاری که می خوای انجام بدی باید از دستورات SQL استفاده کنی.
اگر از کامپونت ADO استفاده می کنی دستور جستجوش به این شرحه :
Ado1.RecordSource= "Select * From [your table] Where [your field] Like ('%متن مورد نظر برای جستجو%')"
ولی اگر از کامپونت Data استفاده می کنی دستورش اینطوری می شه :
Data1.RecordSource= "Select * From [your table] Where [your field] Like ('*متن مورد نظر برای جستجو*')"
مثال : مثلا من یک Table با نام Table1 و یک فیلد به نام Address دارم و می خوام تمام آدرسهایی که توشون ( تهران ) داره پیدا کنم ، حالا این کلمه می خواد هرجایی از فیلد باشه :
Ado1.CommandType = adCmdText
Ado1.RecordSource= "Select * From Table1 Where Address Like ('%تهران%')"
Ado1.Refresh
*******************************
بستن پنجره با گرفتن عنوان ان
اگر کاربر پنجره ای رو که شما تعیین می کنید رو باز کنه برنامه اون فرم رو می بنده.
در اینجا ما از دو تا تابع API استفاده می کنیم که عبارتند از : FindWindowA برای پیدا کردن پنجره مورد نظر و SetForegroundWindow برای فعال کردن پنجره مورد نظر که هر دوی این توابع در فایل user32.dll تعریف شده اند.
اول برای تعریف توابع فوق خطوط زیر رو در قسمت General وارد کنید :
Private Declare Function FindWindowA Lib "user32.dll" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Dim Temp As Long
حالا روی فرمتون یه Timer قرار بدین و خاصیت Interval اون رو به 50 تغییر بدید، بعد روی اون دابل کلیک کنید و کد های زیر رو در Sub مربوط به Timer قرار بدین:
Temp = FindWindowA(vbNullString, "My Computer")
If Temp <> 0 Then
SetForegroundWindow (Temp)
SendKeys "%{F4}"
End If
دستور اول هندل ( لازم به ذکر است که سیستم عامل به هر کنترلی و به هر فرمی شماره ای اختصاص می ده که به این شماره میگن هندل) پنجره ای رو که ( در اینجا ) عنوانش My Computer باشد رو در متغیر Temp می ریزد. شرط بعدی چک می کند که پنجره مورد نظر پیدا شده یا نه که در صورت برقراری این شرط با تابع SetForegroundWindow (که آرگومانش همون شماره ای باید باشه که با تابع FindWindowA پیدا کردیم) پنجره پیدا شده رو فعال می کنه و در نهایت تابع SendKeys زهر خودش رو می ریزه و با ارسال یک کلید میانبر به نام Alt+F4 کاربر عزیز رو در باز کردن پنجره مورد نظرش ناکام می کنه!
*******************************
بدست آوردن IP و نام سيستم ميزبان
برای امروز قصد دارم يک پروژه ساده را به شما معرفی کنم.
شما ظرف چند دقيقه ميتوانيد اين پروژه را در ويژوال بيسيک بسازيد.
ابتدا ويژوال بيسيک را باز کنيد سپس کنترلر های زير را روی فرم قرار دهيد :
دو عدد TextBox و دو عدد WinSock
حالا روی فرم دو بار کليک کرده و در رويداد لود فرم کدهای زير را وارد کنيد :
Text1.Text = Winsock1.LocalIP
Text2.Text = Winsock2.LocalHostName
برنامه را اجرا کنيد . اين برنامه آی پی و پورت سيستم ميزبان را در اختيار شما قرار ميدهد.
لازم به ذکر است بعدا که به مرحله ساخت اسب های تراوا رسيديم
خدمت شما عرض خواهم کرد که کاربرد اين برنامه در هک سيستم قربانيان چيست
*******************************
تبدیل رادیان به درجه
چون اکثر توابع مثلثاتی بر حسب رادیان کار می کنند گاهی اوقات نیاز داریم تا زوایا را از در جه به رادیان و بالعکس تبدیل کنیم. برای تبدیل یک زاویه بر حسب رادیان به درجه، آنرا در 180 ضرب کرده و سپس بر عدد پی تقسیم میکنیم:
Degree(x) = x * 180 / Pi
برای تبدیل یک زاویه بر حسب درجه به رادیان، آنرا در عدد پی ضرب کرده و سپس بر 180 تقسیم میکنیم:
Rad(x) = x * Pi / 180
*******************************
یک سری کدهای اماده ویژوال بیسیک براتون میزارم تا تمرین کنید
'frmtrst:
'give the nomber of numbers
'give n numbers
'get average
Option Explicit
Private Sub cmdcalculate_Click()
Dim totcount, totnum, ncount, inputno As Integer
Dim naver As Single
lbldisp.Caption = ""
totcount = Val(txtcount.Text)
Do While ncount < totcount
inputno = InputBox("Enter a no ", "input no")
ncount = ncount + 1
totnum = totnum + inputno
Loop
If totcount > 0 Then
naver = totnum / ncount
End If
lbldisp.Caption = "The average is " & naver
txtcount.Text = ""
End Sub
*******************************
'frm421
'10*10 stars
Option Explicit
Private Sub cmdstar_Click()
Dim i As Integer
For i = 1 To 100
Print "*";
If i Mod 10 = 0 Then
Print
End If
Next i
End Sub
*******************************
'frm0605
'the most little
Option Explicit
Private Sub cmdsmall_Click()
Dim val1 As Long, val2 As Long, val3 As Long
val1 = txtone.Text
val2 = txttwo.Text
val3 = txtthree.Text
Call minimum(val1, val2, val3)
End Sub
Private Sub minimum(min As Long, y As Long, z As Long)
If y < min Then
min = y
End If
If z < min Then
min = z
End If
lblsmall.Caption = "smallest value is " & min
End Sub
*******************************
'count & print even
'frm0703
Option Explicit
Private Sub cmdprint_Click()
Dim s(9) As Integer
Dim x As Integer
Cls
For x = LBound(s) To UBound(s)
s(x) = 2 + 2 * x
Next x
For x = LBound(s) To UBound(s)
Print Space$(2) & x & Space$(7) & s(x)
Next x
End Sub
*******************************
'frm0706
Option Explicit
Dim marray(-5 To 5) As Integer
Private Sub cmdarray_Click()
Dim x As Integer
Call initialize
Call modifyarray(marray())
Call printmodified
End Sub
Private Sub cmdelement_Click()
Dim x As Integer
Call initialize
For x = LBound(marray) To UBound(marray)
Call modifyelement(marray(x))
Next x
Call printmodified
End Sub
Private Sub cmdexit_Click()
End
End Sub
Private Sub initialize()
Dim x As Integer
lstoriginal.Clear
lstmodified.Clear
For x = LBound(marray) To UBound(marray)
marray(x) = x
lstoriginal.AddItem marray(x)
Next x
End Sub
Private Sub printmodified()
Dim x As Integer
For x = LBound(marray) To UBound(marray)
lstmodified.AddItem marray(x)
Next x
End Sub
Private Sub modifyarray(a() As Integer)
Dim x As Integer
For x = LBound(a) To UBound(a)
a(x) = a(x) * 2
Next x
End Sub
Private Sub modifyelement(element As Integer)
element = element * 5
End Sub
*******************************
'frmboolean
Option Explicit
Private Sub cmdprint_Click()
Dim bool As Boolean
Dim x As Integer
x = -1
Print "x" & vbTab & "bool"
Do Until x = 10
bool = x
Print x & vbTab & bool
x = x + 1
Loop
Print
bool = True
Print bool
bool = False
Print bool
End Sub
*******************************
'frmsecurity
Option Explicit
Dim maccesscode As Long
Private Sub cmd3_Click()
txtdisplay.Text = txtdisplay.Text & "3"
End Sub
Private Sub cmd4_Click()
txtdisplay.Text = txtdisplay.Text & "4"
End Sub
Private Sub cmd5_Click()
txtdisplay.Text = txtdisplay.Text & "5"
End Sub
Private Sub cmd6_Click()
txtdisplay.Text = txtdisplay.Text & "6"
End Sub
Private Sub cmd7_Click()
txtdisplay.Text = txtdisplay.Text & "7"
End Sub
Private Sub cmd8_Click()
txtdisplay.Text = txtdisplay.Text & "8"
End Sub
Private Sub cmd9_Click()
txtdisplay.Text = txtdisplay.Text & "9"
End Sub
Private Sub cmdclear_Click()
txtdisplay.Text = ""
End Sub
Private Sub cmdenter_Click()
Dim message As String
lstlongentery.Clear
maccesscode = Val(txtdisplay.Text)
txtdisplay.Text = ""
Select Case maccesscode
Case Is < 1000
message = "Aceess Denied "
Beep
Case 1645 To 1689
message = "Technican personnel"
Case 8345
message = "Custodial Services"
Case 55875
message = "Special Services"
Case 999898, 1000006 To 1000008
message = "Scientific Personal"
Case Else
message = "Acess DEnied "
End Select
lstlongentery.AddItem Now & Space$(3) & message
End Sub
Private Sub cmdone_Click()
txtdisplay.Text = txtdisplay.Text & "1"
End Sub
Private Sub cmdzero_Click()
txtdisplay.Text = txtdisplay.Text & "0"
End Sub
Private Sub cmd2_Click()
txtdisplay.Text = txtdisplay.Text & "2"
End Sub
*******************************
'frmfig0614
Option Explicit
Private Sub cmddivide_Click()
Dim numerator As Integer, denominator As Integer
Dim result As String
numerator = txtnum.Text
denominator = txtden.Text
result = divide(numerator, denominator)
If result = "" Then
lblthree.Caption = "divide by zero"
Else
lblthree.Caption = result
End If
End Sub
Private Function divide(n As Integer, d As Integer) As String
If d = 0 Then
Exit Function
Print "after exit function "
Else
divide = "division yields " & n / d
End If
End Function
*******************************
'frmfig0310
Option Explicit
Dim sum As Integer
Private Sub cmdadd_Click()
sum = sum + txtinput.Text
txtinput.Text = ""
txtsum.Text = sum
End Sub
Private Sub cmdexit_Click()
End
End Sub
*******************************
'frmdraw
Option Explicit
Private Sub cmddraw_Click()
Dim side As Integer, row As Integer, column As Integer
side = txtinput.Text
Cls
If side <= 12 Then
If side > 0 Then
row = 1
While row <= side
column = 1
While column <= side
If row = 1 Or row = side Or column = 1 Or column = side Then
Print "$";
Else
Print "&";
End If
column = column + 1
Wend
Print
row = row + 1
Wend
Else
Print "side too small "
Beep
End If
Else
Print "side too large "
Beep
End If
End Sub
*******************************
'frmdisplay
Option Explicit
Private Sub cmdprint_Click()
Dim counter As Integer
txtinput.SetFocus
counter = 0
counter = Val(txtinput.Text)
lbldisplay.Caption = ""
'txtinput.SetFocus
Do While counter > 0
lbldisplay.Caption = lbldisplay.Caption & "#"
counter = counter - 1
Loop
End Sub
*******************************
'frmcompund
Option Explicit
Private Sub cmdcal_Click()
Dim years As Integer
Dim interestrate As Double
Dim amount As Currency
Dim principal As Currency
lstdisplay.Clear
years = 10
principal = txtamount.Text
interestrate = txtinterest.Text / 100
lstdisplay.AddItem "year " & vbTab & "amount on deposit"
For years = 1 To 10
amount = principal * (1 + interestrate) ^ years
lstdisplay.AddItem Format$(years, "@@@@") & vbTab & Format$(Format$(amount, "currency"), _
String$(17, "@"))
Next years
End Sub
Private Sub cmdexit_Click()
End
End Sub
موضوعات مرتبط: آموزش ، ،
برچسبها:
انواع متغیرها:
متغیرها در ویژوال بیسیک به دو دسته عددی و غیر عددی تقسیم بندی می شوند. داده های عددی نیز خود به دو گروه صحیح و اعشاری تقسیم می شوند. داده های غیر عددی شامل داده های منطقی ، رشته ای ، تاریخ و زمان و شیء می باشند ، که هر کدام را به اختصار توضیح می دهیم.
الف) متغیرهای عددی :
در زیر جدولی از این نوع برحسب میزان حافظه اشغالی مرتب شده اند، که دانستن آن برای پیشروی در آموختن لازم است:
باره قابل قبول |
نوع متغیر |
۰ تا ۲۵۵ |
Byte |
۳۲۷۶۷- تا ۳۲۷۶۸ |
Integer |
۲۱۴۷۴۸۳۶۷- تا ۲۱۴۷۴۸۳۶۴۸ |
Long |
تمام متغیرهایی که از یکی از این سه نوع تعریف شوند فقط پذیرای اعداد صحیح خواهند بود. اگر یک عدد اعشاری به این نوع متغیرها نسبت داده شود فقط قسمت صحیح عدد در متغیر قرار می گیرد.
انواع متغیرهای اعشاری هم به این صورت هستند:
بازه قابل قبول |
نوع متغیر |
گستره وسیعی با ۶ رقم اعشار |
Single |
گستره وسیعی با ۱۴ رقم اعشار |
Double |
۴ رقم اعشار |
Currency |
نکته: توجه نمایید که نوع Currency بیشتر برای محاسبات مالی و اداری استفاده می شود.
ب ) متغیر رشته ای :
در نوشتن اکثر برنامه ها نیاز به متغیرهایی خواهد شد که حروف و کلماتی مثل نام افراد را نگهداری کنند. در ویژوال بیسیک این کار به عهده متغیرهایی هستند که از نوع String تعریف شوند.
ج ) متغیرهای دو مقداری ( منطقی ) :
گاهی متغیری لازم است که بتواند یکی از دو مقدار True یا False ( همان صفر و یک، یا درست و نادرست) را در خود نگهداری کند. این نوع در برنامه با کلمه کلیدی Boolean مشخص می شود. در ادامه با این متغیرها بیشتر آشنا خواهید شد.
د ) نوع تاریخ و زمان :
توضیح خاصی ندارد! فقط به یاد داشته باشید که با کلمه کلیدی Date مشخص می شود. همانگونه که از نام آن پیداست، برای کار با زمان و تاریخ کاربرد دارد.
ه ) نوع Variant:
این نوع می تواند انواع متغیرهای بالا را در خود جای دهد! یعنی در یک قسمت می تواند عدد باشد، و در قسمت دیگر رشته، و . . . !! البته بر خلاف گستردگی ظاهریش چندان پر کاربرد نیست.
تعریف متغیرها:
برای تعریف متغیر - و یا در واقع اعلان نوع آن - از ساختار زیر استفاده می کنیم:
Dim نام متغیر As نوع متغیر
به مثال های زیر توجه کنید:
Dim x As Double
Dim n , m As Integer
Dim fname , str1 , str2 As String * 10
دستور اول x را از نوع اعشاری double تعریف می کند.
در دستور دوم دو متغیر m و n از نوع صحیح integer تعریف می شوند (به علامت , بین دو متغیر توجه کنید).
در سطر سوم str1 ، fname و str2 هر سه از نوع String تعریف می شوند. با این تفاوت که رشته str2 حداکثر می تواند ۱۰ کاراکتر بپذیرد.
نکته بسیار مهم: در حقیقت تعریف کردن متغیرها در زبان ویژوال بیسیک باعث جلوگیری از بروز خطا وکمتر مصرف شدن حافظه می شود، و شما می توانید بدون این که متغیرها را تعریف کنید از آنها استفاده نمایید. اگر چه این امر بر وفق مراد تازه کاران است، ولی بهتر است در برنامه متغیرها را تعریف، و سپس استفاده کنید. یکی از مزایای این کار این است که اگر در برنامه ای نام متغیری را اشتباه تایپ کنید هنگام اجرای آن خطای عدم شناسایی متغیر دریافت می کنید. در صورتی که قصد دارید همواره از قاعده تعریف قبل از استفاده را به کار ببرید، کافی است عبارتOption Explicit را قبل از همه کدهای برنامه تایپ کنید.
برای مقدار دهی به متغیرهای تعریف شده دو روش وجود دارد: با دستورات انتساب - که با علامت = انجام می پذیرد - ، و با دستورات ورودی.
ما با دستور = به متغیرهای عددی که در بالا تعریف شده اند مقدار می دهیم:
x = -21.2
n = x
m = ( n + 2 ) * 3 ^ 2 / 5
fname = "ali"
در دستور اول عدد اعشاری 21.2- در x قرار می گیرد. دستور مقدار 21- را در n قرار می دهد.( چرا که n از نوع صحیح تعریف شده است.) مقدار m هم بر اساس تقدم عملگرها تعیین می شود. ترتیب این تقدم به صورت زیر است:
· ( ) : عبارتهای داخل جفت پرانتز بیشترین تقدم رو دارند.
· ^ : توان ریاضی
· * و / : ضرب و تقسیم اعشاری
· \ : تقسیم صحیح (یعنی حاصل این تقسیم همیشه عدد صحیح می باشد.)
· Mod : باقیمانده تقسیم را می دهد. مثلا در عبارت x = 15 Mod 2 مقدار x برابر 1 می شود.
· – و + : جمع و تفریق معمولی
بر اساس مطالب فوق مقدار m به این صورت محاسبه می شود:
m = ( -21 + 2 ) * 3 ^ 2 / 5 = -19 * 3 ^ 2 / 5 = -19 * 9 / 5 = -171 / 5 = -34.2
آخرین دستور کلمه ali را در متغیر رشته ای fname قرار می دهد. اما چرا ali داخل جفت گیومه قرار گرفته؟ عیارت زیر چرا درست عمل نمی کند؟
fname = ali
دو حالت مختلف را بررسی می کنیم:
اول: در ابتدای کدها از Option Explicit استفاده شده است. در این صورت برنامه به دنبال متغری با نام ali می گردد.
دوم: در ابتدای کدها از Option Explicit استفاده نشده است. در این صورت برنامه فرض می کند ali متغیری است رشته ای، و - چون هیچ مقدار خاصی ندارد - رشته تهی در fname قرار می گیرد.
هر دوی این حالتها برخلاف انتظار ماست. لذا برای جلوگیری از چنین اشتباهاتی در ویژوال بیسیک رشته ها (دقت کنید که رشته ها، نه متغیرهای رشته ای) درون " " قرار می گیرند.
حال به عبارات زیر توجه کنید:
str1 = ”Visual “ + ”Basic”
str2 = str1
str1 = 1 + 3
fname = str1 + ” is an integer number”
در دستور اول دو رشته داخل گیومه با هم الحاق شده ، و رشته “Visual Basic” درون str1 قرار می گیرد. با دستور & نیز می توان همانند + دو رشته را به هم متصل نمود.
در دستور دوم محتویات متغیر str1 جایگزین محتویات str2 می شود. اما با توجه به اینکه str2 حداکثر گنجایش ۱۰ کاراکتر را دارد، تنها عبارت "Visual Bas" در آن قرار می گیرد.
در خط سوم سمت راست عملگر انتساب یک عدد صحیح، و سمت چپ یک رشته است. اما چون مقدار سمت راست در متغیر سمت چپ قرار داده می شود - که از نوع رشته ای است - مقدار عددی ۴ به مقدار رشته ای ۴ تبدیل می شود. یعنی:
str1 = "4"
توجه داشته باشید که دو عبارت زیر با هم تفاوت دارند:
str1 = 1 + 3
str1 = "1 + 3"
بر اساس توضیحات فوق در نهایت مقدار متغیر fname به صورت زیر خواهد یود:
fname = str1 + " is an Integer number" = "4" + " is an Integer number" = "4 is an Integer number"
نکته بسیار مهم: البته در نام گذاری متغیر ها باید از قوانین خاصی پیروی کرد. فاصله در نام گذاری متغیر ها مجاز نیست.
مثلاً Dim Ali Reza As Integer غلط است چرا که بین دو کلمه Ali و Reza فاصله است.
موضوعات مرتبط: آموزش ، ،
برچسبها:
ویژوال بیسیک توسعه یافته زبان برنامهنویسی بیسیک میباشد. بیسیک توسط پروفسور جان کمنسی و توماس کرتز از کالج دارتموث برای نوشتن برنامههای ساده ایجاد شد. طراحی آن از اواسط دهه ۱۹۶۰ آغاز گردید.
ویژوال بیسیک تا نسخه ۳ به صورت ۱۶ بیتی بود. از نسخه ۵ به بعد فقط ویرایش ۳۲ بیتی آن ارائه شد. (نسخه ۴ هم به صورت ۱۶ بیتی و هم به صورت ۳۲ بیتی عرضه شده بود)
ویژوال بیسیک از نسخه ۶ به بعد بر پایه چارچوب داتنت (NET.) ارائه شد.
اگر چه با ظهور ویژوال بیسیک دات نت اکثر برنامهنویسان ویژوال بیسیک ۶ به آن گرویدند، ولی نسخه ۶ همچنان طرفداران ویژهٔ خود را دارد.
ویژوال بیسیک برای توسعه سریع نرمافزار (RAD یا Rapid Application Development) بر پایهرابط گرافیگی کاربر (GUI یا Graphical User Interface) توسعه داده شد. دسترسی آسان و سریع به پایگاه دادهها با استفاده از DAO ،RDO یا ADO و ایجاد کنترلهای اکتیو ایکس از جمله مواردی هستند که این زبان را برای RAD مناسب کردهاند.
برنامهنویسی در ویژوال بیسیک به صورت برنامهنویسی رویدادمحور و برنامهنویسی شیءگرا میباشد.
در برنامهنویسی تجاری، ویژوال بیسیک جز محبوبترینها است. بنابه آماری که در سال ۲۰۰۳ منتشر شد، ۵۳٪ از برنامههای تجاری با استفاده از این زبان تولید شدهاند.
برچسبها: